日常業務では、毎月や毎日のように複数のExcelファイルを集計・加工するケースがあります。
VBAを使えば、指定フォルダ内のすべてのブックを自動で開いて処理することが可能です。
1. フォルダ内のすべてのブックを順に処理する
Sub ProcessMultipleWorkbooks()
Dim wb As Workbook
Dim filePath As String
Dim folderPath As String
'処理対象フォルダのパス
folderPath = "C:\Test\"
'最初のファイルを取得
filePath = Dir(folderPath & "*.xlsx")
'ファイルがなくなるまでループ
Do While filePath <> ""
'ブックを開く
Set wb = Workbooks.Open(folderPath & filePath)
'===== ここに処理を書く =====
'例：A1セルの値をメッセージ表示
MsgBox wb.Sheets(1).Range("A1").Value
'保存せずに閉じる
wb.Close SaveChanges:=False
'次のファイルへ
filePath = Dir
Loop
End Sub解説：
Dir(folderPath & "*.xlsx")… 指定フォルダの 「.xlsx」を含むファイル名を取得Do While filePath <> ""… ファイルがなくなるまで繰り返すWorkbooks.Open… ブックを開くwb.Close SaveChanges:=False… 保存せず閉じる（必要に応じて変更）
2. 集計処理の例（複数ブックからデータを1つにまとめる）
Sub AggregateDataFromWorkbooks()
Dim wb As Workbook
Dim destWs As Worksheet
Dim filePath As String
Dim folderPath As String
Dim lastRow As Long
Dim pasteRow As Long
folderPath = "C:\Test\"
Set destWs = ThisWorkbook.Sheets("集計")
pasteRow = 1
filePath = Dir(folderPath & "*.xlsx")
Do While filePath <> ""
Set wb = Workbooks.Open(folderPath & filePath)
'元ブックの最終行を取得
lastRow = wb.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
'A1から最終行までコピーして集計シートへ
wb.Sheets(1).Range("A1:A" & lastRow).Copy _
Destination:=destWs.Range("A" & pasteRow)
'次の貼り付け行を更新
pasteRow = pasteRow + lastRow
wb.Close SaveChanges:=False
filePath = Dir
Loop
End Sub解説：
lastRow… データの最終行を取得してコピー範囲を決定pasteRow… 集計シートの貼り付け開始行を管理- これで、複数ブックのデータを縦にまとめられる
3. 注意点
- フォルダ内のファイル構造（シート名や列構成）が同じであることが前提
- 大量のブックを処理する場合、処理速度のために画面更新を停止するのがおすすめ
Application.ScreenUpdating = False '停止
'処理
Application.ScreenUpdating = True '戻す- ファイル形式が混在する場合（xls、xlsm、xlsxなど）、
Dirのパターンを"*.*"に変更して判定処理を追加すると対応できる
コメント