フォルダ内の全シート1を取りまとめる

Sub フォルダ内の全シート1を取りまとめる()
    Dim フォルダパス As String
    Dim 対象ファイル As String
    Dim 対象ブック As Workbook
    Dim 一時ブック As Workbook
    Dim シート As Worksheet
    Dim 合成シート As Worksheet
    Dim 最終行 As Long

    Application.ScreenUpdating = False

    '新しいワークブックを作成
    Set 一時ブック = Workbooks.Add
    Set 合成シート = 一時ブック.Sheets(1)

    '合成シートの行数を初期化
    最終行 = 1

    '対象フォルダのパスを取得
    フォルダパス = "ここにフォルダのパスを入力してください" ' <-- ここにフォルダのパスを入力してください

    'フォルダ内のExcelファイルを処理
    対象ファイル = Dir(フォルダパス & "\*.xlsx") 'フォルダ内のExcelファイルを取得

    Do While 対象ファイル <> ""
        'Excelファイルを開く
        Set 対象ブック = Workbooks.Open(フォルダパス & "\" & 対象ファイル)

        'シート1を合成シートにコピー
        対象ブック.Sheets(1).UsedRange.Copy 合成シート.Cells(最終行, 1)

        '最終行の更新
        最終行 = 最終行 + 対象ブック.Sheets(1).UsedRange.Rows.Count

        '次のファイルへ
        対象ブック.Close False
        対象ファイル = Dir
    Loop

    '合成データの書き込みが終了したので、合成ワークブックを保存
    一時ブック.SaveAs フォルダパス & "\合成データ.xlsx"

    '合成ワークブックを閉じる
    一時ブック.Close False

    Application.ScreenUpdating = True
    MsgBox "合成が完了しました。", vbInformation
End Sub