Excelシート名が重複してらシート名に連番を付加させる方法

初心者ですが、誰かが紹介していたので同じように入れてみました。
入力した登録№がそのままシート名になって便利だなと使っていたのですが、
同じ登録№を入力するとシートの名前変更のところでエラーになってしまいます。
同じシート名なら（2）（3）と連番を付加してエラーにならないようにするには
どうすればよいでしょうか？

Private Sub CommandButton1_Click()
Dim Sheet_Name As String
'入力'
Sheet_Name = InputBox("登録№***を5桁で入力して下さい。「登録用シートが作成され
　　　　　　　　　　　　　　ます｡」 ")
'「キャンセルボタン」または「×ボタン」を押した場合'
If Sheet_Name = "" Then
Exit Sub
Else
End If

'シートのコピー'
Worksheets("書式サンプル").Copy Before:=Worksheets("書式サンプル")
'シートの名前変更'
ActiveSheet.Name = Sheet_Name
End Sub

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2021/08/27 17:29

こんにちは

多分、こんな感じになるのだけれど、

Private Sub CommandButton1_Click()
Dim Sheet_Name As String, chkSH As String
Dim i As Integer
Dim sh As Worksheet
'入力'
chkSH = InputBox("登録№***を5桁で入力して下さい。「登録用シートが作成されます｡」 ")
'「キャンセルボタン」または「×ボタン」を押した場合'
If chkSH = "" Then Exit Sub
Sheet_Name = chkSH
CHK:
For Each sh In Worksheets
If sh.Name = Sheet_Name Then
i = i + 1
Sheet_Name = chkSH & "(" & i & ")"
GoTo CHK
End If
Next
'シートのコピー'
Worksheets("書式サンプル").Copy Before:=Worksheets("書式サンプル")
'シートの名前変更'
ActiveSheet.Name = Sheet_Name
End Sub

この回答へのお礼

素早くご回答いただき恐縮です。
試してみたところエラーもなく、連番も作成されました。
感謝いたします。

お礼日時：2021/08/27 18:46

No.2 回答者： mygoonickname 回答日時： 2021/08/27 17:54

こんばんは。

少し変わった方法ですが、エラー処理で回避する方法です。
試してないので、エラーになるかも知れませんが、適宜修正して下さい。


最初の方に、下記を記載。
Dim N as Long,Sheet_Name_BackUp as String
On Error GoTo myError



'シートのコピー'
N=1
Sheet_Name_BackUp = Sheet_Name
ActiveSheet.Name = Sheet_Name

On Error Goto 0
Eixt sub

myError:
N=N+1
Sheet_Name = Sheet_Name_BackUp & "(" & N & ")"

Resume
End Sub


エラーが発生すると、ｍｙErrorの行へジャンプ
エラー処理をして、Resumeで、エラーの命令に戻る。

少しでも参考になればと。