VBAで複数のExcelファイルのデータを集計する

「フォルダに入っている複数のExcelファイルを開いてデータをコピーし、集計シートに貼り付ける」という作業をVBAで自動化します。ファイルを1つずつ開かなくてよくなるコードを解説します。

想定するケース

以下のような状況を想定しています。

C:\集計\支店データ\ というフォルダに、各支店のExcelファイル（.xlsx）が入っている
各ファイルのフォーマットは統一されている（A〜D列にデータが入っている）
全ファイルのデータを1つの集計ファイルにまとめたい

基本コード

このマクロは「集計.xlsm」という別のファイルから実行することを想定しています。

Sub 複数ファイルを集計()

    Dim folderPath As String   ' 対象フォルダのパス
    Dim fileName As String     ' ファイル名（順番に取得）
    Dim wb As Workbook         ' 開くファイル
    Dim wsSrc As Worksheet     ' 転記元のシート
    Dim wsDest As Worksheet    ' 転記先のシート（集計シート）
    Dim lastRowSrc As Long     ' 転記元の最終行
    Dim destRow As Long        ' 転記先の書き込み位置

    ' 集計先シートの設定
    Set wsDest = ThisWorkbook.Worksheets("集計")

    ' 集計シートの既存データをクリア（1行目のヘッダーは残す）
    If wsDest.Cells(2, 1).Value <> "" Then
        wsDest.Range("A2:D" & wsDest.Rows.Count).ClearContents
    End If
    destRow = 2

    ' 対象フォルダのパス（末尾に\をつける）
    folderPath = "C:\集計\支店データ\"

    ' フォルダ内の最初のExcelファイルを取得
    fileName = Dir(folderPath & "*.xlsx")

    ' ファイルがなくなるまで繰り返す
    Do While fileName <> ""

        ' ファイルを非表示で開く
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open(folderPath & fileName)

        ' 1枚目のシートを対象にする
        Set wsSrc = wb.Worksheets(1)

        ' 転記元の最終行を取得
        lastRowSrc = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row

        ' データがある場合のみ転記
        If lastRowSrc >= 2 Then
            wsSrc.Range("A2:D" & lastRowSrc).Copy _
                Destination:=wsDest.Cells(destRow, 1)
            destRow = destRow + (lastRowSrc - 1)
        End If

        ' ファイルを保存せずに閉じる
        wb.Close SaveChanges:=False

        ' 次のファイルを取得
        fileName = Dir()

    Loop

    Application.ScreenUpdating = True
    MsgBox "集計完了！ " & destRow - 2 & " 件のデータをまとめました。"

End Sub

コードの解説

`Dir()` 関数でフォルダ内のファイルを順番に取得する

fileName = Dir(folderPath & "*.xlsx")

Dir() はフォルダ内のファイル名を1件ずつ返す関数です。*.xlsx はExcelファイルのみを対象にするワイルドカード指定です。

fileName = Dir()  ' 引数なしで次のファイルを取得

2回目以降は引数なしで呼ぶと、次のファイル名を返します。ファイルがなくなると空文字（""）を返すため、Do While fileName <> "" でループを回します。

`Application.ScreenUpdating = False` で処理を高速化する

Application.ScreenUpdating = False

画面の更新を止めることで、ファイルを開いたり閉じたりする処理が画面に見えなくなり、大幅に処理速度が上がります。処理が完了したら必ず True に戻してください。

ファイルを閉じるときに保存しない

wb.Close SaveChanges:=False

SaveChanges:=False を指定することで、開いたファイルを変更なしで閉じます。集計元のファイルを誤って変更しないための安全策です。

ファイル名も一緒に記録したい場合

どのファイルから転記したかをE列に記録しておくと、後で確認しやすくなります。

If lastRowSrc >= 2 Then
    Dim copyCount As Long
    copyCount = lastRowSrc - 1

    wsSrc.Range("A2:D" & lastRowSrc).Copy _
        Destination:=wsDest.Cells(destRow, 1)

    ' E列にファイル名を記録
    wsDest.Cells(destRow, 5).Resize(copyCount, 1).Value = fileName

    destRow = destRow + copyCount
End If

特定のシート名を指定したい場合

1枚目のシートではなく、特定の名前のシートを対象にする場合は以下のように変更します。

' 「データ」という名前のシートを対象にする
On Error Resume Next
Set wsSrc = wb.Worksheets("データ")
On Error GoTo 0

' シートが存在しない場合はスキップ
If wsSrc Is Nothing Then
    wb.Close SaveChanges:=False
    fileName = Dir()
    GoTo NextFile  ' 次のファイルへ
End If

フォルダ選択ダイアログを出したい場合

フォルダパスをコードに直書きせず、実行時にダイアログで選べるようにする方法です。

' フォルダ選択ダイアログを表示
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "集計するフォルダを選択してください"

If fd.Show = True Then
    folderPath = fd.SelectedItems(1) & "\"
Else
    MsgBox "キャンセルされました。"
    Exit Sub
End If

実行前の確認事項

「集計」という名前のシートがマクロを含むファイルに存在するか
集計対象のフォルダパスが正しいか
各ファイルのデータが同じ列構成になっているか
集計元ファイルが他のユーザーによって開かれていないか（開かれているとエラーになります）

まとめ

Dir() 関数でフォルダ内のファイルを順番に取得し、Workbooks.Open で開いてデータをコピーする——このパターンを覚えると、数十・数百のファイルをまとめる作業が数秒で終わります。ファイルを開いて閉じるたびに画面が切り替わらないよう ScreenUpdating = False を使うことで、処理速度も大幅に改善されます。