|
とりあえず、一案。
Sub test()
Dim var As Variant
Dim sh As Worksheet
On Error Resume Next
'シートコピー
Worksheets("Sheet1").Copy After:=Worksheets(Worksheets.Count)
Do
var = Application.InputBox(Prompt:="シート名を入力してください")
'キャンセル時はコピーしたシートを削除して処理終了
If VarType(var) = vbBoolean Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Exit Do
End If
Set sh = Worksheets(var)
If sh Is Nothing Then
ActiveSheet.Name = var
Set sh = Worksheets(var)
If sh Is Nothing Then MsgBox "不正なシート名です"
Else
MsgBox "既に同名のシートが存在しています"
Set sh = Nothing
End If
Loop While (sh Is Nothing)
On Error GoTo 0
Set sh = Nothing
End Sub
内容については、ヘルプで御確認ください。
|
|