シートの存在を調べて存在しなければ新しいシートを作成

頻繁に使うロジックなので関数化してみました。

• 任意の名称を持つシートが存在するかどうか調べる
• 上記で存在しなければその名称で作成（もしくはあるシートをコピーしてその名称にする）

    ' 呼び出し例(1)
    Dim wsSheet As Worksheet
    Set wsSheet = SelectSheet("シートA", "テンプレート")
    ' → 常に wsSheet = ThisWorkbook.Sheets("シートA") となる。
    '    ただし、「シートA」が存在すればそのシート、
    '    存在せず、「テンプレート」シートが存在すればそれをコピーしたもの、
    '    「テンプレート」シートも存在しない場合は新規シート。

    ' 呼び出し例(2)
    Dim wsSheet As Worksheet
    Set wsSheet = SelectSheet("シートA")
    ' → 常に wsSheet = ThisWorkbook.Sheets("シートA") となる。
    '    ただし、「シートA」が存在すればそのシート、
    '    存在しない場合は新規シート。

'*
'* シートがなければ作成orコピーする関数
'* （有効なsBaseSheetが指定された場合、そのシートをコピーして名称をsSheetNameとする）
'*
'* [in]  sSheetName：取得するシートの名称
'*       sBaseSheet：コピー元　※省略可
'* [out] SelectSheet：取得したシート
'*
'* 使用関数：CheckExistSheet
'*
Private Function SelectSheet(ByVal sSheetName As String, Optional ByVal sBaseSheetName As String = "") As Worksheet

    ' 変数
    Dim wsSheet As Worksheet
    Dim bFlag As Boolean
    
    ' シートの存在を調べ、なければ作る
    If CheckExistSheet(sSheetName) <> True Then
        ' 存在しないので、作成orコピーする
        If sBaseSheetName = "" Or CheckExistSheet(sBaseSheetName) = False Then
            ' コピー元シートを指定されていないor無効なシートなので新規作成
            ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Else
            ' コピー元シートをコピーして名称変更
            ' ※Copyの引数はコピーした後の位置。After:=(Before:=)を用いて指定する
            With ThisWorkbook.Sheets(sBaseSheetName).Copy(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                ActiveSheet.Name = sSheetName
            End With
        End If
    End If
    
    '指定された名称のシートを返す
    Set SelectSheet = ThisWorkbook.Sheets(sSheetName)
    
End Function

'*
'* シートが存在するか調べる関数
'*
'* [in]  sSheetName：存在を調べるシート名
'* [out] CheckExistSheet：結果(存在すればTrue、しなければFalse)
'*
Private Function CheckExistSheet(ByVal sSheetName As String) As Boolean

    ' 変数
    Dim wsSheet As Worksheet
    
    ' 戻り値のデフォルト値をFalseに
    CheckExistSheet = False
    
    For Each wsSheet In Worksheets
        If wsSheet.Name = sSheetName Then
            ' シートが存在すれば戻り値をTrueにしてループから抜ける
            CheckExistSheet = True
            Exit For
        End If
    Next wsSheet
    
End Function