EXCEL VBA ワークシートの追加・複数追加・先頭・最後（Worksheets.Addメゾット）

EXCEL VBA ワークシートの追加・複数追加・先頭・最後（Worksheets.Addメゾット）

Worksheets.Addメゾットの利用方法（指定追加・前に追加・最後に追加）

'
'******** AKIRA55.COM ******* https://akira55.com/add_worksheet/
'
'パターン①－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub WorksheetsAdd01() 'ワークシート（Sheet1）の後ろにシートが追加されます。


    ThisWorkbook.Worksheets.Add After:=Worksheets("Sheet1"), Count:=1


End Sub

'パターン②－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub WorksheetsAdd02() 'ワークシート（Sheet1）の前にシートが追加されます。


    ThisWorkbook.Worksheets.Add Before:=Worksheets("Sheet1"), Count:=1


End Sub

'パターン③－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub WorksheetsAdd03() '作業中ブックの最後にシートを追加します。


    ThisWorkbook.Worksheets.Add After:=Worksheets(ThisWorkbook.Worksheets.Count), Count:=1


End Sub

'パターン④－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub WorksheetsAdd04()  'ワークシート（大阪）の後ろにシートを２つ追加されます。


    ThisWorkbook.Worksheets.Add After:=Worksheets("大阪"), Count:=2


End Sub
'

指定するワークシートの挿入先に指定するシート名でシートを挿入する。

'
'******** AKIRA55.COM ******* https://akira55.com/add_worksheet/
'

Sub WorksheetsAdd05()  '指定するワークシートの挿入先に指定するシート名で挿入する。

    Dim Ws01 As Worksheet
    Dim SheName, InsName As String
    Dim I, lRow As Long
    
    Set Ws01 = Worksheets("シート名一覧")
    ws01.Select
    lRow = Ws01.Cells(Rows.Count, "A").End(xlUp).Row 'シート「シート名一覧」Ａ列の最終行を取得します。
    
    For I = 2 To lRow  'シート「シート名一覧」Ａ列の最終行分繰り返します。
        
    SheName = Ws01.Cells(I, "A"): InsName = Ws01.Cells(I, "B")  '挿入元と挿入するシート名を代入します。
    
        With ThisWorkbook.Worksheets.Add(After:=Worksheets(SheName), Count:=1)  '指定する場所にシートを挿入します。
            .Name = InsName '挿入したシート名を変更します。
        End With

    Next I

End Sub
'

ワークシートを挿入した際に、シート名が重複した場合の対処（対応・回避）

'
'
'******** AKIRA55.COM ******* https://akira55.com/add_worksheet/
'
Sub WorksheetsAdd06()  'ワークシートを挿入した際に、シート名が重複した場合の対処（対応・回避）
    Dim Ws, ws01 As Worksheet
    Dim Dic, I, L, lRow As Long
    Dim Temp01, Temp02 As String
    Dim Flag As Boolean
    Dim Keys
       
    Set Dic = CreateObject("Scripting.Dictionary")
    
    Set ws01 = Worksheets("シート名一覧")
    ws01.Select
    For Each Ws In ThisWorkbook.Worksheets  '現在のワークシートを辞書登録します。
         Dic.Add Ws.Name, Ws.Name
    Next Ws
    
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'シート「シート名一覧」Ａ列の最終行を取得します。
    
    
    For I = 2 To lRow

        Temp01 = Cells(I, "A")  'シート「シート名一覧」のA列のセルデータ（挿入するシート名）を代入します。
                
        Temp02 = Temp01
        
        L = 1  'シートが重複した時の初期値１番～
                            
        Do
                
            If Not Dic.Exists(Temp02) Then
                    Dic.Add Temp02, Temp02  '重複しないシート名を登録します。（辞書登録）
                    Exit Do
                Else
                    Temp02 = Temp01 & L  'シート名が重複した時に連番を付ける。
                    L = L + 1  '連番を加算する。
            End If
            
            If L > 250 Then Exit Sub ' 重複する同じシート名の連番が250を超えたら終了
            
        Loop While 250 > L  '連番作成の最大値250まで設定。
    
    Next I
    
    Keys = Dic.Keys
    
    For I = 0 To Dic.Count - 1  '辞書登録したデータの最終まで繰り返す。
    
        Flag = False  '初期値：Flag　=　False
        
        For Each Ws In ThisWorkbook.Worksheets  '現在のワークシートに対してこれから登録するシート名が有るか調べます。
            If Ws.Name = Keys(I) Then Flag = True  '既にワークシートが存在していれば、True
        Next Ws
        
         If Flag = False Then 'ワークシート名が無ければ追加する。
                ThisWorkbook.Worksheets.Add After:=Worksheets(ThisWorkbook.Worksheets.Count), Count:=1 'シートを挿入します。
                ActiveSheet.Name = Keys(I) '挿入したシート名を変更します。
         End If

                
    Next I
    
    Set Dic = Nothing
    
    
End Sub
'