マクロを使って複数シートの表をまとめてみたくなったので、
マクロを使って複数シートの表をまとめてみました。
前回記事


ソースコードは前回からの継ぎ足しです。
VBAでやりたいこと
・指定したキーワードを含むシート名の中にある表をすべて取得する
・↑この処理を、複数ファイルに対して同様に行う
・処理画面をいちいち表示させず、高速に処理を行う
状況設定
場所 C:\work\vba
inフォルダ:読み取りたいエクセルファイルがあるフォルダ
outフォルダ:書き込みたいエクセルファイル(out.xlsx)を出力するフォルダ
test3.xlsm:マクロを実行するエクセルファイル
inフォルダ内にはファイルが複数存在しています。
これらをすべて読み込みたいです。
読み込みたいファイルの中身はこちら↑
同一フォーマットで、同じような表がシートごとに存在します。
表のあるシート名は、必ず『表●●』です。該当のシートのみを全て選択し、うまく表を抜き出したいです。
入力フォルダ、出力フォルダはエクセルのシート上で指定させます。
出力はout.xlsxの名前で新規作成して保存します。
実装
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 |
'複数ファイルの読み込み→別ファイルに書き込み Sub csvmerge() 'Excelの画面を非表示に Application.ScreenUpdating = False '変数宣言 Dim InFilename As String Dim Book_in As Workbook 'ブック(入力) Dim Book_out As Workbook 'ブック(出力) Dim Sheet_in As Worksheet Dim Path_in As String 'フォルダパス(入力) Dim Path_out As String 'フォルダパス(出力) Dim PX As Long '座標(貼り付け位置) Dim xlLastRow As Long 'Excel自体の最終行 Dim StartRow As Long '開始行 Dim LastRow As Long '最終行 'フォルダのパスを取得 Path_in = range("F4") Path_out = range("F7") InFilename = Dir(Path_in & "\*.xlsx") '入力ファイルの開始行 StartRow = 5 '出力ファイルを新規作成して変数に格納 Set Book_out = Workbooks.Add Book_out.SaveAs Filename:=Path_out & "¥" & "out.xlsx" '出力ファイルの出力開始位置 PX = 2 '入力ファイルの数だけループ Do While InFilename <> "" '入力ファイルを開いて変数に格納 Workbooks.Open Path_in & "¥" & InFilename Set Book_in = ActiveWorkbook 'シートの数だけループ For Each Sheet_in In Worksheets 'シート名頭に『表』が含まれる場合 If Sheet_in.Name Like "表*" Then '/*********************************** 表コピー処理 ***************************************************/ '入力ファイルの最終行を取得 xlLastRow = Book_in.Worksheets(Sheet_in.Name).Cells(Rows.Count, 1).Row 'Excelの最終行を取得 LastRow = Book_in.Worksheets(Sheet_in.Name).Cells(xlLastRow, 2).End(xlUp).Row 'B列の最終行を取得 '入力ファイルをコピーして出力ファイルに張り付け Book_in.Worksheets(Sheet_in.Name).Rows(StartRow & ":" & LastRow).Copy Book_out.Worksheets("Sheet1").Rows(PX) '次の出力ファイルの書き込み位置を調整 PX = PX + LastRow - StartRow '/*******************************************************************************************************/ End If Next 'ブックを閉じる Book_in.Close 'まだ選んでないフォルダ内のファイルを選択 InFilename = Dir() Loop 'ブックを保存 Book_out.Save 'ブックを閉じる Book_out.Close End Sub |
①指定したキーワードを含むシート名の中にある表をすべて取得する
1 2 3 4 5 6 7 8 9 |
'シートの数だけループ For Each Sheet_in In Worksheets 'シート名頭に『表』が含まれる場合 If Sheet_in.Name Like "表*" Then '/*********************************** 表コピー処理 ***************************************************/ 略 '/*******************************************************************************************************/ End If Next |
ファイル内にあるシートの数だけループします。
変数Sheet_in にシート情報が毎回格納。
Sheet_in.Name でシート名を取得出来ます。
あとはLikeを使った条件分岐を行い、正のときのみコピー処理を行うようにしました。
②1の処理を複数ファイルに対して行う

これは前回記事で紹介しました。
③処理画面をいちいち表示させず、高速に処理を行う
頭に1行追加するだけです。
1 2 |
'Excelの画面を非表示に Application.ScreenUpdating = False |
結果
出力はこのようになりました。
複数ファイル、複数シートの表が一つにまとまりました。