特定のフォルダ内のすべてのワークブックをループして、データをマスターシートにコピーするにはどうすればよいですか？

あるフォルダ内に複数のExcelワークブックがあり、それらすべてのファイルをループして、特定の範囲（例：Sheet1）からデータを抽出し、マスターワークシートにコピーする必要があるとします。このガイドでは、Excelでのこのプロセスを効率化するための詳細なVBAソリューションを提供します。

VBAコードを使用して、ディレクトリ内のワークブックをループし、データをマスターシートにコピーする

VBAコードを使用して、ディレクトリ内のファイルをループし、データをマスターシートにコピーする

特定のフォルダにあるすべてのワークブックのSheet1のA1:D4の範囲からデータをコピーして、それをマスターシートに貼り付けたい場合は、次の手順を実行してください。

1. マスターワークシートを作成するワークブックで、Alt + F11キーを押してMicrosoft Visual Basic for Applicationsウィンドウを開きます。

2. Microsoft Visual Basic for Applicationsウィンドウで、挿入 > モジュールをクリックします。次に、以下のVBAコードをコードウィンドウにコピーします。

VBAコード: フォルダ内のファイルをループして、データをマスターシートにコピーする

Sub Merge2MultiSheets()
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook, xWorkBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    xSheetName = "Sheet1"
    xRgStr = "A1:D4"
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            Set xWorkBook = ThisWorkbook
            Set xSheet = xWorkBook.Sheets("New Sheet")
            If xSheet Is Nothing Then
                xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
                Set xSheet = xWorkBook.Sheets("New Sheet")
            End If
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            Do Until xFileName = ""
               Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
                Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
                xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

注釈:

3. F5キーを押してコードを実行します。

4. 開く参照ウィンドウで、ループ処理を行うファイルが含まれるフォルダを選択し、OKボタンをクリックします。スクリーンショットをご覧ください:

「New Sheet」という名前のマスターワークシートが現在のブックの最後に作成されます。そして、選択したフォルダ内のすべてのSheet1の範囲A1:D4のデータがそのワークシート内にリストされます。

関連記事:

• Excelでセルのデータを行の高さと列の幅と一緒にコピーするにはどうすればよいですか？