シート挿入あれこれ 3

記事「シート挿入あれこれ 2 」のつづき…

記事「シート挿入あれこれ 」のなかで
シートの挿入方法について
次の4通りを考えました。

１．既存シートを削除した上で、新たに同名のシートを挿入する。
２．既存シートの全セルを削除して、新たにシートを挿入しない。
３．既存シートの名前を変更して残し、新たにシートを挿入する。
４．既存シートをそのまま残し、
　　新たに挿入するシートの名前に番号を付けていく。

ここでは、
４．既存シートをそのまま残し、
　　新たに挿入するシートの名前に番号を付けていく。
についてVBAでやってみます。

手順は、まず
shnameで指定した名前と一致するシートがあるか調べます。
あれば、shnameに番号を付けて、shnameを変更します。

番号を付けて変更したshnameと
名前が一致するシートがあるかどうか調べるために
For Each...Next ステートメントの前まで戻ります。

再度、番号を付けて変更したshnameと一致するシートがあれば
番号を１つ大きくしてshnameを変更します。

これを、名前がshnameと一致するシートがなくなるまで繰り返します。
最後に名前をshnameにしてシートを挿入します。

コードはこちら

Sub macro100316a()
'SheetAddCNameの使用例
    SheetAddCName ("macro100316a")
End Sub

Sub SheetAddCName(shname As String)
'現在のWorkbookに同名 のSheetがないか確認する。
'あれば、新しいSheetに番号を付けて挿入する
   
    Dim sh As Object
    Dim shname2 As String
    Dim num, NameLen As Integer
    NameLen = Len(shname)
    num = 2
    
Step1:
    For Each sh In Worksheets
        If sh.Name = shname Then
            shname = Left(shname, NameLen) & num
            num = num + 1
            GoTo Step1
        End If
    Next sh
   
    'シートを挿入
    Sheets.Add.Name = shname

End Sub

シートmacro100316aがない状態から
macro100316aを数回実行した状態が下の画像です。

Len関数、Left関数の説明はVBAヘルプにあります。