あのー、複数のエクセルファイルを一括で１ファイルにまとめる方法ってありますか。
あー、標準機能では用意されていませんね。
そうですよねー。めんどうだなー。
マクロで解決する方法があるみたいですよ、ご紹介しましょう！
複数のエクセルファイルを一括で１ファイルにまとめるマクロをご紹介します。
目次
マクロ機能が有効なExcelブック「.xlsm」を作成
Excelブック「.xlsm」の作成方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】マクロ機能が有効なExcelブック「.xlsm」の作り方
作成したマクロファイルに名前を設定して保存します。
※ここでは「同じフォルダにある複数のエクセルを一括でまとめるVBA.xlsm」と設定します。
コードを標準モジュールに貼り付け
標準モジュールの開き方が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】標準モジュールの開き方
標準モジュールを開いて、下記のコードを貼り付けて下さい。
コード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 | Option Explicit '############################################################################# ' Main '############################################################################# Sub Main() MsgBox "まとめたいエクセルブックのフォルダを選択して、" & vbCrLf & _ "「OK」をクリックして下さい。" '画面表示OFF Application.ScreenUpdating = False '------------------------------------------- ' 変数定義 '------------------------------------------- Const cnsDIR = "\*.xls*" '対象フォルダ内エクセルファイル検索用 Dim FilePath As String 'ファイルパス Dim strFileName As String '結合元ファイル名 Dim i As Integer 'ループ用 'シート結合エクセル用オブジェクト Dim App As Excel.Application Dim Book As Workbook Dim Sheet As Worksheet 'シート結合エクセル保存名 Dim BookName As String '結合元エクセル用 Dim Book2 As Workbook Dim Sheet2 As Worksheet '------------------------------------------- ' シート結合後のファイル名の指定 '------------------------------------------- BookName = Format(Now(), "yyyymmdd-hhmmss") & "【まとめファイル】.xlsx" '------------------------------------------- ' 結合元のフォルダ選択 '------------------------------------------- FilePath = FolderSelect() 'キャンセル時 If FilePath = "" Then MsgBox "キャンセルされました。処理を終了します。" End End If '------------------------------------------- ' 結合先ワークブック作成 '------------------------------------------- 'オブジェクトセット Set App = CreateObject("Excel.Application") '非表示 App.Visible = False 'エクセル新規オープン Set Book = App.Workbooks.Add '------------------------------------------- ' 結合先ワークブックにコピー '------------------------------------------- ' 先頭のファイル名の取得 strFileName = Dir(FilePath & cnsDIR, vbNormal) ' ファイルが見つからなくなるまで繰り返す Do While strFileName <> "" '対象フォルダ配下のエクセルオープン Set Book2 = App.Workbooks.Open(Filename:=FilePath & "\" & strFileName) '開いたコピー元のエクセルのシート分繰り返す For i = 1 To Book2.Worksheets.Count Book2.Worksheets(i).Visible = True '結合用のブックにシートコピー Book2.Worksheets(i).Copy after:=Book.Worksheets(i) 'シート名を「元のエクセル名.元のシート名」に変更 Book.ActiveSheet.Name = Book2.Name & "." & Book2.Worksheets(i).Name 'エラー時処理 On Error GoTo Err1 Next i 'コピー元のエクセルを保存せずに閉じる Book2.Close (False) ' 次のファイル名を取得 strFileName = Dir() Loop '------------------------------------------- ' 結合したエクセルの終了 '------------------------------------------- 'シート「Sheet1」を削除 Book.Worksheets("Sheet1").Delete '名前を付けて保存 Book.SaveAs Filename:=FilePath & "\" & BookName 'エクセルを閉じる Book.Close (False) '------------------------------------------- ' 終了処理 '------------------------------------------- Set Sheet2 = Nothing Set Book2 = Nothing Set Sheet = Nothing Set Book = Nothing Set App = Nothing MsgBox "処理を完了します。" '画面表示ON Application.ScreenUpdating = True End 'エラー時処理 Err1: Application.DisplayAlerts = False MsgBox "シート名が正しくありません。" & vbCrLf & _ "下記がエラー理由と思われます。" & vbCrLf & vbCrLf & _ "◆想定されるエラー理由" & vbCrLf & _ "・結合元ブック名+拡張子+シート名が32文字以上なっている。" & vbCrLf & _ "・結合元ブック名に、シート名に設定出来ない文字が含まれている。" & vbCrLf & _ ":、\、/、?、*、[、]、" & vbCrLf & vbCrLf & _ "結合元ブック名、シート名の修正後、マクロを実行してください。" & vbCrLf & vbCrLf & _ "処理を終了します。", Title:="エラー" '画面表示ON Application.DisplayAlerts = True End End Sub '############################################################################# ' フォルダ参照用 '############################################################################# Function FolderSelect() As String '------------------------------------------- ' 変数定義 '------------------------------------------- Dim objFileDialog As Object 'FileDialog Dim strTitle As String 'タイトル Dim strPath As String 'フォルダパス Dim strInitialPath As String '初期フォルダパス '------------------------------------------- ' フォルダ選択ダイアログの初期設定 '------------------------------------------- 'ダイアログタイトル strTitle = "結合元のフォルダを選択してください" 'ダイアログの初期パスをモジュール起動エクセルに設定 strInitialPath = ActiveWorkbook.Path '------------------------------------------- ' フォルダ選択ダイアログ表示 '------------------------------------------- Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker) With objFileDialog 'タイトル .Title = strTitle '初期フォルダパス .InitialFileName = strInitialPath If .Show = False Then 'キャンセル時 GoTo Exit_Function Else 'フォルダパス取得 strPath = .SelectedItems(1) End If End With '------------------------------------------- ' 終了処理 '------------------------------------------- Exit_Function: Set objFileDialog = Nothing FolderSelect = strPath End Function |
ダミーデータを準備する
マクロ実行テスト用のダミーデータとして、エクセルファイルを準備します。
※フォルダ名は任意です。例として「エクセルをまとめるテストフォルダ」と入力します。
マクロを実行する
マクロファイルを開いて、「コンテンツの有効化」をクリックします。
※設定により、「コンテンツの有効化」は表示されない（クリック不要の）場合もあります。
「開発」タブをクリックします。
「マクロ」をクリックします。
マクロ「Main」を選択、「実行」をクリックします。
「OK」をクリックします。
まとめたいエクセルファイルが格納されているフォルダを選択→「OK」をクリックします。
「OK」をクリックします。
まとめるエクセルファイルと同じフォルダに「yyyymmdd-hhmmss【まとめファイル】.xlsx」が作成されます。
「yyyymmdd-hhmmss【まとめファイル】.xlsx」を開くと、対象のエクセルのシートがコピーされています。
完了です。
注意点
ファイル名＋拡張子＋シート名の文字数を31文字以内にする
本VBAでまとめる「ファイル名＋拡張子＋シート名」の文字数は、
合計で31文字以内にしてください。
「yyyymmdd-hhmmss【まとめファイル】.xlsx」のシート名は、
「ファイル名＋拡張子＋シート名」で作成されます。
エクセルの仕様上、シート名は31文字以内の為、
「ファイル名＋拡張子＋シート名」の文字数が、
合計で32文字以上になるとエラーになります。
※ファイル名・シート名を一括置換するエクセルVBAは下記記事を参考にしてください。
ファイル名を一括取得するVBAと一括置換するVBA
エクセルのシート名を一括取得するVBA
エクセルのシート名を一括置換するVBA
その他
※本VBA機能を含む、VBAマクロツールを作成しました。
下記の記事からダウンロードしてお試し下さい。
【累計1,100ダウンロード突破！！】汎用エクセルVBAツール【HUNT】
マクロ実行動画
