表構造が同じ複数シートを1つのシートに統合する【Excel VBA】

Sub sheet_merge()

  Dim i As Integer
  Dim lRow As Long, lCol As Long, lRow2 As Long
  Dim newSh As String
  Dim Sh As Worksheet, myFlag As Boolean
    
    
    Application.ScreenUpdating = False
    
    
    newSh = "全データ"  'まとめ用のシート名です
    myFlag = False  'まとめ用のシートが有ったら True /無かったら False にするフラッグです
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name = newSh Then
            myFlag = True
            '-全データシートのデータをクリアし、先頭へ移動します
            Worksheets(newSh).Cells.ClearContents
            Worksheets(newSh).Move before:=Sheets(1)
            Exit For
        End If
    Next Sh
    
    '-全データシートを先頭へ追加します
    If myFlag = False Then
        ActiveWorkbook.Worksheets.Add(before:=Worksheets(1)).Name = newSh
    End If
    
    

    
    '-列見出しをコピーします(下記は1行目の場合、1～5行目がヘッダの場合は「Range("1:5")」のようにする)
    Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
    rast_row2 = Worksheets(1).Cells(100000, 2).End(xlUp).Row + 1
    
    For i = 2 To Worksheets.Count
        With Worksheets(i)
            
       
        rast_row = Worksheets(i).Cells(100000, 2).End(xlUp).Row
        Worksheets(i).Activate
        Range(Cells(2, 1), Cells(rast_row, 16384)).Copy Worksheets(1).Cells(rast_row2, 1) ' 最初の　Cells(2, 1)はヘッダ行に合わせて修正する ヘッダが5行目まである時は、Cells(6, 1)にする。
        rast_row2 = Worksheets(1).Cells(100000, 2).End(xlUp).Row + 1
            
        End With
    
    Next i
    
    Worksheets(1).Activate
    Range("A1").Select
    Application.ScreenUpdating = True


End Sub