VBA閻魔帳 小技編　��02

●ワークシートの複製
　シートに同一名があれば、再度促します
Sub　複製()

Dim Q
Dim MyNAME
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

On Error Goto error1

Q = MsgBox("シートの複製を作成しますか？", vbInformation + vbYesNo, "複製")
If Q = 7 Then Exit Sub

MyNAME = InputBox(MyNAME & "でいいですか？", "シート名入力", MyNAME)

For Each sh In Worksheets
　If sh.Name = MyNAME Then
　　　MsgBox "同じ名前のシートがあります" & Chr(13) & _
　　　　　　"別名にしてください!!"

　　MyNAME = InputBox("別名で名前を入れてください", "シート名入力", MyNAME)

Next

Sheets(1).Copy After:= Sheets(1)
ActiveSheet.Name = MyNAME

error1:

With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With

End Sub