|
暇だったので、作ってみました。
Sub shtcopy()
Dim shtName As String
Dim i As Long
MsgBox "現在のシートをコピーします"
ReName:
shtName = Application.InputBox("シート名を入力して下さい。", "シート名入力", Type:=2)
If shtName = "False" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
For i = 1 To Worksheets.Count
If Worksheets(i).Name = shtName Then
MsgBox shtName & " は、既にあります。", vbExclamation, "エラー"
GoTo ReName
End If
Next i
On Error GoTo WrongName
ActiveSheet.Copy before:=Worksheets(1)
ActiveSheet.Name = shtName
On Error GoTo 0
MsgBox "完了"
Exit Sub
WrongName:
MsgBox "シート名に使えない文字が含まれています。", vbExclamation, "エラー"
shtName = Application.InputBox("シート名を入力して下さい。", "シート名入力", Type:=2)
Resume 0
End Sub
|
|