⚡
MergeWorkbooks
自動化選択したExcelファイルの全シートを現在のブックにコピーします
複数のExcelブックを一つのブックにまとめるマクロです。指定したフォルダ内のすべてのExcelファイルを開いて、各シートをアクティブブックにコピーします。毎月別々のファイルで管理している月次データを年次集計ブックにまとめる・部署別ファイルを一つの統合ブックに集約するなど、定期的な統合作業を自動化できます。手動でのコピー&ペースト作業が不要になり、大量ファイルの統合も一瞬で完了します。内部ではDir関数でフォルダ内のファイルを列挙し、Workbooks.Openで順次開いてはWorksheet.Copyで統合先ブックにシートを追加しています。CopyToNewWorkbookが1つのブックから切り出す処理であるのに対し、本マクロは逆に複数ブックを1つへ集約する処理にあたり、月次・年次の集計フローで対になって使われます。
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： MergeWorkbooks を実行し、取り込むExcelファイルを選択します
🎯 活用シーン
- ✓部門ごとに別々のExcelファイルで管理している月次データを、年次集計用の一つのブックにまとめて年次報告書を作成したいとき
- ✓支店・担当者別に分かれているファイルを一つに集約して、全社データの集計・分析を効率よく行いたいとき
- ✓プロジェクトごとに分散しているデータファイルを定期的に一つのマスターブックに統合する作業を自動化したいとき
- ✓全国の支店から送られてくる週次報告ファイルを、本社で一つの集計ブックにまとめたいとき
- ✓プロジェクトメンバーがそれぞれ作成した作業ログファイルを、月末に一括統合して振り返り資料を作りたいとき
💡 実装のヒント
- ▸コピー元のブックを開いてシートをコピーする処理のため、ファイル数が多い場合は処理時間がかかります。Application.ScreenUpdatingをFalseに設定してから実行すると高速化できます。
- ▸シート名が重複する場合、自動的に連番が付与されます（Sheet1, Sheet1(2)など）。必要に応じてシート名変更ロジックを追加してください。
- ▸パスワード保護されたブックは自動的には開けません。保護されたファイルへの対応が必要な場合は、Workbook.OpenでPasswordを指定してください。
- ▸統合対象のファイル形式（.xlsx、.xlsmなど）をDir関数のパターンで絞り込んでおくと、意図しないファイルの混入を防げます。
- ▸処理完了後は開いたブックを確実にCloseすることをコードに含め、メモリやファイルロックの残留を防いでください。
💻 VBAコード
' MergeWorkbooks
' -----------------
' Macro Name: MergeWorkbooks
' Description: 選択したExcelファイルの全シートを現在のブックにコピーします
' Parameters: なし
' Returns: なし
' Usage: MergeWorkbooks を実行し、取り込むExcelファイルを選択します
' -----------------
Sub MergeWorkbooks()
On Error GoTo ErrorHandler
Dim filePath As Variant
Dim srcWb As Workbook
Dim destWb As Workbook
Dim ws As Worksheet
Dim copiedCount As Long
Set destWb = ActiveWorkbook
filePath = Application.GetOpenFilename( _
"Excelファイル (*.xlsx;*.xlsm;*.xls), *.xlsx;*.xlsm;*.xls", , _
"取り込むExcelファイルを選択")
If filePath = False Then Exit Sub
Set srcWb = Workbooks.Open(filePath, ReadOnly:=True)
copiedCount = 0
For Each ws In srcWb.Worksheets
ws.Copy After:=destWb.Sheets(destWb.Sheets.Count)
copiedCount = copiedCount + 1
Next ws
srcWb.Close SaveChanges:=False
MsgBox copiedCount & " シートを取り込みました", vbInformation, "完了"
Exit Sub
ErrorHandler:
If Not srcWb Is Nothing Then srcWb.Close SaveChanges:=False
MsgBox "エラーが発生しました:" & vbCrLf & Err.Description, vbCritical, "エラー"
End Sub