【ExcelVBA・マクロ】複数ブックから特定条件のデータだけを抽出して1枚に集計する方法

Excelの実務でよくあるのが、「バラバラのファイルに保存されているデータの中から、特定の項目（例えば『未完了』のタスクや『特定の担当者』など）だけを集めたい」という場面です。

1つずつファイルを開いてコピーするのは時間がかかりますが、VBAを使えば数秒で終わります。

今回は、指定したフォルダ内にある全てのExcelファイルを巡回し、条件に一致する行だけをマスターシートに転記するコードを紹介します。

今回紹介するコードの動作イメージ
複数ブックからデータを抽出するVBAコード
コードのポイント解説
このマクロの使い方
カスタマイズのヒント
まとめ

今回紹介するコードの動作イメージ

指定したフォルダ内のExcelファイルを1つずつ開く。
各ファイル内のデータを確認し、条件（例：B列が「未完了」など）に合う行を探す。
条件に合う行があれば、集計用ブックの末尾にコピーする。
ファイルを閉じて、次のファイルへ。

それでは、具体的なコードを見ていきましょう。

複数ブックからデータを抽出するVBAコード

以下のコードを、集計用ブックの標準モジュールに貼り付けてください。

VBA

Sub ExtractDataFromWorkbooks()
    Dim targetFolder As String
    Dim fileName As String
    Dim srcWB As Workbook
    Dim srcWS As Worksheet
    Dim destWS As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim writeRow As Long
    Dim condition As String
    
    ' --- 設定項目 ---
    ' 1. 抽出条件を指定（例：B列が「未完了」のもの）
    condition = "未完了"
    
    ' 2. フォルダを選択するダイアログを表示
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            targetFolder = .SelectedItems(1) & "\"
        Else
            Exit Sub ' キャンセル時は終了
        End If
    End With
    
    ' 3. 出力先のシートを設定
    Set destWS = ThisWorkbook.Sheets(1)
    
    ' 画面更新を停止（高速化）
    Application.ScreenUpdating = False
    
    ' フォルダ内のExcelファイルを検索
    fileName = Dir(targetFolder & "*.xlsx")
    
    Do While fileName <> ""
        ' 自ブックは除外
        If fileName <> ThisWorkbook.Name Then
            ' ブックを読み取り専用で開く
            Set srcWB = Workbooks.Open(targetFolder & fileName, ReadOnly:=True)
            Set srcWS = srcWB.Sheets(1) ' 各ブックの1枚目のシートを対象
            
            ' 開いたブックの最終行を取得
            lastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
            
            ' 2行目から最終行までループ（1行目はヘッダーと想定）
            For i = 2 To lastRow
                ' B列が条件に一致するか判定
                If srcWS.Cells(i, 2).Value = condition Then
                    ' 集計先の最終行を取得して転記
                    writeRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row + 1
                    srcWS.Rows(i).Copy Destination:=destWS.Rows(writeRow)
                End If
            Next i
            
            ' ブックを閉じる（保存しない）
            srcWB.Close SaveChanges:=False
        End If
        
        ' 次のファイルを検索
        fileName = Dir()
    Loop
    
    ' 画面更新を再開
    Application.ScreenUpdating = True
    
    MsgBox "抽出が完了しました！", vbInformation
End Sub

コードのポイント解説

1. フォルダ選択ダイアログの利用

Application.FileDialog(msoFileDialogFolderPicker) を使うことで、コード内でパスを直接書き換える手間を省いています。実行するたびに、対象のフォルダを自由に選べます。

2. Dir関数でのファイル巡回

Dir(targetFolder & "*.xlsx") を使うことで、指定フォルダ内の拡張子が「.xlsx」のファイルだけを順番に処理しています。

3. 条件分岐（If文）

If srcWS.Cells(i, 2).Value = condition Then の部分で、抽出条件を判定しています。今回の例では「2列目（B列）」を見ていますが、ここを書き換えることで「C列が1000以上の数値」や「D列に『重要』を含む」といったカスタマイズが可能です。

4. 高速化処理

Application.ScreenUpdating = False を入れることで、ファイルを開いたり閉じたりする動きを画面に映さないようにしています。これにより、処理速度が劇的に向上します。

このマクロの使い方

集計用のExcelブックを新規作成します。
Alt + F11 でVBEを開き、「挿入」→「標準モジュール」をクリックします。
上記のコードをコピー＆ペーストします。
F5 キーで実行、またはボタンを作成してマクロを登録します。
フォルダ選択画面が出るので、対象のファイルが入っているフォルダを選んで「OK」を押します。

カスタマイズのヒント

特定の列だけをコピーしたい場合 現在は Rows(i).Copy で行全体をコピーしていますが、特定の範囲（例：A列〜E列）だけにしたい場合は、srcWS.Range("A" & i & ":E" & i).Copy のように書き換えてください。
サブフォルダも含めたい場合 今回のコードは指定したフォルダ直下のファイルのみが対象です。サブフォルダまで含める場合は、再帰処理というテクニックが必要になります（別の記事で紹介予定です）。

まとめ

複数ブックからのデータ抽出は、手作業だとミスが起きやすく、非常に時間がかかる作業です。このマクロをベースに、自分の業務に合わせて条件式を少し書き換えるだけで、事務作業の効率がグッと上がりますよ。

ぜひ活用してみてください！