複数のブックのワークシートを統合した新規ブックを作成2023.07.07
複数のブックの全ワークシートを統合した、新規ブックを作成するマクロです。
マクロ「ConsolidateBooks」を実行すると、ファイル選択ダイアログボックスが表示されます。そのダイアログボックスで複数のExcelファイルを選択し「開く」をクリックすると、選択した全てのブックの全てのワークシートが、新規ブックにコピーされ1つに統合されます。
※ マクロ実行ブック以外を閉じた状態でマクロを実行してください
※ 選択したファイルの数やサイズによっては処理完了まで時間を要します
[全ワークシートを一括出力]はこちら
【サンプルコード実行動画】 ※次の動画の氏名や住所はすべてダミーデータです
Excelマクロ管理ツール
サンプルコード2023.07.07
'------------------------------------------------------------------------------- ' 複数のブックのワークシートを統合した新規ブックを作成 '------------------------------------------------------------------------------- ' 複数のブックの各ワークシートを、 1つの新規ブックに統合するマクロです。 ' マクロを実行するとファイル選択ダイアログボックスが表示されるので、 ' 複数のExcelファイルを選択してください。 ' ファイルの選択が1つの場合は、統合の対象外となりますので気をつけてください。 ' またマクロを実行するときには、マクロを実行するブック以外は閉じてください。 ' ※ 選択したファイルの数やサイズによっては処理完了まで時間を要します ' '[作成日] 2023/06/27 [更新日] 2023/07/08 ' https://excel.syogyoumujou.com/vba/consolidate_books.html '------------------------------------------------------------------------------- Sub ConsolidateBooks() '選択可能ファイルのフィルターを設定 Const C_FILEFILTER As String = "Excelファイル,*.xlsx;*.xls" '開いているブック数が2つ以上の場合は終了 If 1 < Workbooks.Count Then MsgBox "このブック以外のExcelファイルを閉じてください", _ vbExclamation, _ "終了します" Exit Sub End If 'ファイルの選択 Dim varFilesName As Variant varFilesName = Application.GetOpenFilename(C_FILEFILTER, , _ "ファイルを複数選択してください", , _ True) 'キャンセルを選択した場合は終了 If VarType(varFilesName) = vbBoolean Then Exit Sub '選択したファイルが1つの場合は抜ける If UBound(varFilesName) = 0 Then MsgBox "複数のファイルを選択してください", _ vbExclamation, _ "終了します" Exit Sub End If Application.ScreenUpdating = False Application.DisplayAlerts = False '統合用新規ブックを作成 Dim NWB As Workbook Set NWB = Workbooks.Add On Error Resume Next Dim varName As Variant Dim AWB As Workbook Dim CWB As Workbook Dim Sh As Worksheet Dim strErrFiles() As String Dim lngErrCount As Long Dim lngCount As Long For Each varName In varFilesName '選択ファイルとマクロ実行ファイルが同じ場合は処理を行わない If varName = ThisWorkbook.FullName Then 'マクロ実行ファイル統合処理の対象外 Else '選択したファイルを開く Set AWB = Workbooks.Open(varName) For Each Sh In AWB.Worksheets '対象シートをコピーする(新規ブックとしてコピーされる) Sh.Copy Set CWB = ActiveWorkbook '統合用新規ブックにコピーしたシートを移動する CWB.Worksheets(1).Move After:=NWB.Worksheets(NWB.Worksheets.Count) Next '開いたファイルを閉じる AWB.Close False 'エラー確認 If Err.Number = 0 Then lngCount = lngCount + 1 Else Err.Clear ReDim Preserve strErrFiles(lngErrCount) strErrFiles(lngErrCount) = varName lngErrCount = lngErrCount + 1 End If End If Next '統合ブックの1枚目のシートを削除 If 1 < NWB.Worksheets.Count Then NWB.Worksheets(1).Delete On Error GoTo 0 Application.DisplayAlerts = True Application.ScreenUpdating = True '終了メッセージ If lngErrCount = 0 Then MsgBox "新規ブックに" & lngCount & "つのブックを統合しました", _ vbInformation, _ "終了しました" Else MsgBox "エラーになったファイルがあります" & vbLf & vbLf & Join$(strErrFiles, vbLf), _ vbExclamation, _ "終了しました" End If End Sub
選択できるブックの種類を増やすには
ファイル選択ダイアログボックスで選択できるブックの種類は、標準ブックとExcel97-2003ブックです。
マクロブックやテンプレートブックを対象にする場合は、マクロの先頭にある「選択可能ファイルのフィルターを設定」箇所でブックの種類を追加します。
追加方法は、フィルターとなる文字列の最後に「;*.」+「拡張子」を追加します。次の例を参考にしてください。
【例】マクロブックを追加する場合
"Excelファイル,*.xlsx;*.xls" → "Excelファイル,*.xlsx;*.xls;*.xlsm"

【書籍紹介】知りたいがすぐわかる! やりたいがすぐできる!
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」(Kindle版)
ユーザーフォームを扱えると、VBAでできることが大きく広がります!
本書では、知りたいこと、やりたいことから、逆引きで学びを深められます。
140以上のサンプルファイル付き!