(Excel) 複数ブックのシートを一つのブックにまとめるマクロ
以前、報告書をマージする雑務を押し付けられたのでマクロを作成してみた。
マクロの内容は複数ブックのシートを1ファイルのブックにまとめるもの。
やりたいことのイメージ
例となるが、各チームの報告書が画像のように提出されるとする。
中身はこんな感じ。
今回のマクロを実行させ各チームの報告書をまとめたイメージが↓。
中身は各チームの報告書が入っている。
前提(注意点)
- マージ元のシートは1シートのみであること。
- 各ブックでシート名が重複しないこと。
事前準備
マクロ作成前の事前準備。
作業ディレクトリの作成
作業するためのディレクトリを作成する。
マージ元ファイルの格納
マージ元のファイルを格納する。
※「やりたいことのイメージ」の最初の画像
マージ先ファイルの作成
事前にマージ先のディレクトリにエクセルファイルを作成する。
今回は「報告書.xlsx」としておく。
マクロ内容
今回のマクロ(集計ツール.xlsm)を作成していく。
ファイルイメージ
マクロボタンの設置
マージ作業で使用するマクロボタンを設置する。
- ①ファイルパス取得
マージ元ファイルの一覧を取得する。
登録するマクロ関数:filePath - ②シート名取得
一覧に表示された各ファイルのシートを取得する。
登録するマクロ関数:sheetCheck - ③マージファイル作成
一覧のマージ元のファイルを参照し、事前に配置したマージ先のファイルにシートをコピーする。
登録するマクロ関数:merge
マージ先ファイルの記載
マクロファイルのセル:C11にマージ先ファイルのフルパスを記載しておく。
マクロ登録
各ボタンのマクロを記載する。
ファイルパス取得
「①ファイルパス取得」ボタンのマクロ
Sub filePath()
Dim path As String 'ダイアログ選択時のファイルパス
Dim fileName As String 'ファイル名
Dim filePath As String 'ファイルパス(フルパス)
Dim fileCount As Integer 'ファイル数
Dim index As Integer 'インデックス
'ディレクトリ選択用のダイアログを表示する
With Application.FileDialog(msoFileDialogFolderPicker)
'カレントディレクトリを指定
.InitialFileName = ThisWorkbook.path
'設定しなかったら終了
If .Show = False Then Exit Sub
'設定したディレクトリを表示
path = .SelectedItems(1)
End With
'ファイル名を取得します。
fileName = Dir(path & "\*")
index = 0
fileCount = 0
Do While fileName <> ""
'ファイルのフルパスを設定
filePath = path & "\" & fileName
'フルパス情報を出力
Cells(11 + index, 1) = filePath
'インデックスとファイルカウントをインクリメント
index = index + 1
fileCount = fileCount + 1
'次ループ用のファイル名を取得
fileName = Dir()
Loop
'ファイル数を記載
Cells(9, 1) = fileCount
End Sub
シート名取得
「②シート名取得」ボタンのマクロ
Sub sheetCheck()
Dim targetFile As String '処理対象ファイル
Dim ws As Worksheet 'ワーク用WorkSheet
Dim workBookName 'ワーク用ブック名
Dim workSheetName 'ワーク用シート名
Dim index As Integer 'インデックス
'ファイル数分繰り返し処理をする
For index = 1 To Cells(9, 1)
'処理対象ファイルのフルパスを取得
targetFile = Cells(10 + index, 1)
'処理対象ファイルの1シート目のシート名を取得
Set ws = Workbooks.Open(targetFile).Sheets(1)
workBookName = ActiveWorkbook.Name
'シート名を取得
workSheetName = ws.Name
'処理対象ファイルをクローズ
Workbooks(workBookName).Close (False)
'シート名を出力
Cells(10 + index, 2) = workSheetName
Next
'シートの取得完了
MsgBox ("シート名取得完了")
End Sub
マージファイル作成
「③マージファイル作成」ボタンのマクロ
Sub merge()
Dim targetFile '処理対象ファイル
Dim targetSheet '処理対象シート
Dim ws As Worksheet 'ワーク用Worksheet
Dim workBookName 'ワーク用ブック名
Dim index As Integer 'インデックス
Dim ms As Worksheet 'マージ用Worksheet
Dim mergeBookName 'マージ用ブック名
'ファイル数分繰り返し処理をする
For index = 1 To Cells(9, 1)
'処理対象ファイルのフルパスを取得
targetFile = Cells(10 + index, 1)
'処理対象ファイルのシート名を取得
targetSheet = Cells(10 + index, 2)
'マージファイルを開く
Set ms = Workbooks.Open(Cells(11, 3)).Sheets(1)
mergeBookName = ActiveWorkbook.Name
'処理対象のファイルを開く
Set ws = Workbooks.Open(targetFile).Sheets(targetSheet)
workBookName = ActiveWorkbook.Name
'マージ処理を実行
Workbooks(workBookName).Worksheets(targetSheet).Activate
ActiveSheet.Copy After:=Workbooks(mergeBookName).Sheets(Workbooks(mergeBookName).Worksheets.Count)
'処理対象ファイルをクローズ
Workbooks(workBookName).Close (False)
'マージファイルをクローズ
Workbooks(mergeBookName).Close (True)
Next
'マージ処理完了
MsgBox ("マージ処理が正常に完了しました。")
End Sub
使い方
マージ元、マージ先のファイルを格納し、
マクロファイルの①~③の順でボタンを押下すればマージ完了。
②は目視となるがシートが重複していないか確認する用のボタン。