シート挿入あれこれ 2

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

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

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

ここでは、
３．既存シートの名前を変更して残し、新たにシートを挿入する。
についてVBAでやってみます。

「既存シートの名前を変更して残し」の部分についてですが
単純に数字を付けて名前を変更します。

手動で既存のシートをコピーすると
括弧つきで数字がつけられます。

手動でシートをコピーする手順は、
まず、シートのタブのところで右クリック。

[移動またはコピー]を選択すると次のダイアログがでる。

[コピーを作成する]にチェックをいれOKボタンを押す。

この画像は「Sheet1」を3回コピーした状態です。
(2)、(3)、(4)と番号が付けられます。

これは、VBAで既存のシートを同一ワークブックにコピーしたときも
同じです。

ナンバリングを自分でしてもいいのですが
めんどくさいので
とりあえずエクセルちゃんにナンバリングしてもらいます。

手順は、既存のシートをコピーして
Excelに自動で数字を付けてもらって前のシートの名前を変更する。
残ったシートは削除して、新たに同名のシートを追加する。

コードはこちら

Sub macro100315a()
'SheetAddCNameCopyの使用例
    SheetAddCNameCopy ("macro100315a")
End Sub

Sub SheetAddCNameCopy(shname As String)
'現在のWorkbookに同名のSheetがないか確認する。
'あれば、そのSheetをコピーして
'Excelに自動で番号を付けてもらって残す。
'それから削除、新しいSheetを挿入する
   
    Dim sh As Object
   
    For Each sh In Worksheets
        If sh.Name = shname Then
            'シートshnameの後ろにコピーしたシートを挿入
            Sheets(shname).Copy after:=Sheets(shname)
            'シートを削除
            Application.DisplayAlerts = False
            Sheets(shname).Delete
            Application.DisplayAlerts = True
        End If
    Next sh
   
    'シートを挿入
    Sheets.Add.Name = shname

End Sub

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

３．でシートを「削除する」としてしまったけど、
シートの全セルを削除して白紙状態にしてもいいと思います。

つづく