各部署から提出されるExcelファイルを1つずつ開いてコピー＆ペーストする作業、気づけば1時間以上かかっていることはありませんか？この作業はVBAで完全に自動化できます。
この記事では、フォルダ選択ダイアログでフォルダを指定し、中にある全Excelファイルのデータを1つの集計シートにまとめるマクロを解説します。
複数のExcelファイルを自動で集計するには？
今回の想定は次のとおりです。
- 指定フォルダ内に各部署が提出した
.xlsxファイルが複数ある - 各ファイルのシート名は「売上」で統一されている
- データ範囲はA列〜D列（ヘッダーは1行目）
- すべてのデータを1つの「集計」シートにまとめたい
Sub ConsolidateData()
Dim folderPath As String
Dim fileName As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim lastRow As Long
Dim pasteRow As Long
' フォルダ選択ダイアログ
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
folderPath = .SelectedItems(1)
Else
MsgBox "フォルダが選択されていません"
Exit Sub
End If
End With
' 集計先シートの準備
Set wsTarget = ThisWorkbook.Sheets("集計")
With wsTarget
.Cells.ClearContents
.Range("A1").Value = "部署名"
.Range("B1").Value = "商品"
.Range("C1").Value = "数量"
.Range("D1").Value = "金額"
End With
pasteRow = 2
' フォルダ内のファイルを順に処理
fileName = Dir(folderPath & "¥*.xlsx")
Do While fileName <> ""
Set wbSource = Workbooks.Open(folderPath & "¥" & fileName)
Set wsSource = wbSource.Sheets("売上")
lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
' ファイル名（部署名の代わり）をA列に記入
wsTarget.Cells(pasteRow, 1).Resize(lastRow - 1).Value = wbSource.Name
' データをB列以降にコピー
wsSource.Range(wsSource.Cells(2, 1), wsSource.Cells(lastRow, 4)).Copy _
wsTarget.Cells(pasteRow, 2)
pasteRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1
wbSource.Close False
fileName = Dir()
Loop
MsgBox "データの統合が完了しました！"
End Subコードのポイントを理解するには？
Application.FileDialog(msoFileDialogFolderPicker)
フォルダ選択ダイアログを表示します。.Show = -1 はユーザーが「OK」を押した場合（0 はキャンセル）を表します。
Dir(folderPath & "¥*.xlsx")
指定フォルダ内の .xlsx ファイルを1件ずつ取得します。Dir() を繰り返し呼ぶことで次のファイルに進みます。
wbSource.Close False
データ取得後に元ファイルを保存せずに閉じます。False を忘れると「保存しますか？」ダイアログが毎回表示されます。
シート名が異なるファイルに対応するには？
各ファイルのシート名が統一されていない場合は、シート名ではなくインデックス番号で指定します。
' シート名が違っても1枚目のシートを取得する
Set wsSource = wbSource.Sheets(1)開けないファイルをスキップするには？
壊れたファイルや開けないファイルがある場合、On Error Resume Next でエラーをスキップできます。
On Error Resume Next
Set wbSource = Workbooks.Open(folderPath & "¥" & fileName)
On Error GoTo 0
If wbSource Is Nothing Then
fileName = Dir()
GoTo NextFile ' 次のファイルへスキップ
End Ifまとめ
FileDialog(msoFileDialogFolderPicker)でフォルダ選択ダイアログを表示するDir(フォルダパス & "¥*.xlsx")でフォルダ内のファイルを順に取得する- ファイルを開いてデータをコピーし、
Close Falseで保存せずに閉じる - シート名が統一されていない場合は
Sheets(1)でインデックス指定する - 毎月同じ集計作業があるならボタン一つで完結する仕組みを作ると大幅な時短になる
よくある質問
ファイルのシート名がバラバラな場合はどうすればいいですか？
wbSource.Sheets(1) で常に1枚目のシートを対象にする方法が有効です。または For Each ws In wbSource.Sheets で全シートを確認し、特定の列にデータが存在するシートだけを処理することもできます。
ファイルが開けない場合にエラーで止まってしまいます。
On Error Resume Next と On Error GoTo 0 を組み合わせてエラーをスキップできます。開けなかったファイル名をログに記録しておくと後から確認できます。
xlsxだけでなくxlsmも対象にできますか？
できます。Dir(folderPath & "¥*.xls*") とすると .xlsx・.xlsm・.xls などExcel形式のファイルをまとめて対象にできます。
集計先のヘッダー行を残したまま追記できますか？
できます。ClearContents でシートをクリアする代わりに、集計シートの既存データの末尾行を取得して pasteRow の初期値にすれば、実行するたびにデータを追記する形にできます。
処理中に画面がちらつくのを防げますか？
Application.ScreenUpdating = False をマクロの先頭に入れ、末尾で True に戻すと画面更新が止まり処理も高速になります。大量ファイルを扱う場合に特に効果的です。
動画で学びたい方へ
「記事を読んでも、実際に自分で書けるか不安…」という方には、動画で基礎からじっくり学べる講座がおすすめです。
VBAが初めての方を前提に、つまずきやすいポイントを先回りして解説しています。サンプル動画は無料でご覧いただけます。
