複数のファイル、シートを1つのファイルにまとめる

Sub sheetJoin()
Dim sh As Worksheet
sname = "統合" '統合先のシート名
myColumn = 71 '統合元の最大カラム数

Worksheets("統合").Activate

For Each sh In Worksheets
    If sh.Name = sname Then
        Else
        d1 = sh.Range("B65536").End(xlUp).Row '統合元シートのデータ終了行特定
        d2 = Worksheets(sname).Range("B65536").End(xlUp).Row '統合先シートのデータ終了行特定

        Range(sh.Cells(1, 1), sh.Cells(1, myColumn)).Copy Worksheets(sname).Cells(1, 2) 'タイトル挿入
        Range(sh.Cells(2, 1), sh.Cells(d1, myColumn)).Copy Worksheets(sname).Cells(d2 + 1, 2) 'データを統合

        Worksheets(sname).Range("A1", "A1") = "シート名" 'カラム名入力
        Worksheets(sname).Range(Cells(d2 + 1, 1), Cells(d2 + d1 - 1, 1)) = sh.Name 'カラム名を入力

    End If
Next
End Sub