【VBA】重複しないように連番をつけてシートを追加する

ワークシートを追加するときに、同名のシートがあった場合には連番をつけて重複しないようにする方法を紹介します。

自動で複数のワークシートを追加する際に、名前の重複を気にせずに作業することができるようになります。

ワークシートを追加する（基本）
連番をつけてワークシートを追加する
おわり

ワークシートを追加する（基本）

まずは基本のコードです。

Sub シート追加()
    
    Dim wsName As String: wsName = "新規シート" 'ワークシート名
    Dim wbName As String: wbName = ThisWorkbook.Name
    
    Workbooks(wbName).Worksheets.Add.Name = wsName

End Sub

このコードは同名のシートがなければ正常に動作しますが、重複していた場合にはエラーが発生します。

連番をつけてワークシートを追加する

先ほどのコードを改良して、追加しようとするシート名がすでに使われていた場合には連番をつけて追加するようにします。

シート名の確認は、Functionプロシージャの再帰呼び出しによって、重複しなくなるまでチェックを行うようにしています。

Sub シート追加()
    
    Dim wsName As String: wsName = "新規シート" 'ワークシート名
    Dim wbName As String: wbName = ThisWorkbook.Name
    Dim num As Long: num = 0
    
    Call ckName(wsName, num, wbName)
    Workbooks(wbName).Worksheets.Add.Name = wsName

End Sub

Function ckName(ByRef wsName As String, ByRef num As Long, ByVal wbName As String)
    Dim ws As Worksheet
    Dim dummyWsName As String: dummyWsName = wsName
    
    If num <> 0 Then
     dummyWsName = dummyWsName & "(" & num & ")"
    End If
    
    For Each ws In Workbooks(wbName).Worksheets
     If ws.Name = dummyWsName Then
      num = num + 1
      Call ckName(wsName, num, wbName)
      GoTo edFnc
     End If
    Next
    wsName = dummyWsName
    
edFnc:
End Function

このコードでは、あらたにFunctionプロシージャを追加しています。

追加したFunctionプロシージャには、シート名を確認して、重複していた場合には連番をつける機能を持たせています。

連番をつけたシート名がさらに重複していた場合は、Functionプロシージャを再帰呼び出し番号をつけなおすようにしています。

詳細な説明は、次の通りです。