【VBA】指定フォルダ内のExcelデータを全てコピーしてまとめる
システムからデータを引き出して、自分のExcel表にまとめる
という作業は仕事では多いのではないでしょうか?
例えば、冒頭の画面のような作業です。
今回はVBAを駆使して、指定のファルダに入っているExcelデータをコピーして1つのBookにまとめる業務を自動化するサンプルコードを記載していきたいと思います。
例題
『練習』というフォルダに
ファイル名もSheet名もバラバラな4つのExcelデータがあります。
これを自作したまとめBookにコピーして、まとめるとします。
※システムからデータを抜き出す事を想定していますので、前提として、データの項目(見出し)は揃っているとします。
サンプルコード
Application.ScreenUpdating = False
Dim myPath, myFileName As String
Dim myBook As Workbook
Dim mySpace, myRng As Range
Set mySpace = ThisWorkbook.Worksheets(1).Range("A1").CurrentRegion
myPath = "★★★" '★★★にファイル場所を記入してください
myFileName = Dir(myPath & "*.xlsx") '①
Do While myFileName <> "" '②
Set myBook = Workbooks.Open(myPath & myFileName) '③
Set myRng = myBook.Worksheets(1).Range("A1").CurrentRegion '④
Set myRng = myRng.Resize(myRng.Rows.Count - 1).Offset(1) '⑤
myRng.Copy mySpace.Offset(mySpace.CurrentRegion.Rows.Count) '⑥
myBook.Close
myFileName = Dir()
Loop
mySpace.EntireColumn.AutoFit '⑦
Application.ScreenUpdating = True
↑のコードを実行すると以下のようになります。
コードの内容は
Dir関数(ファイルが存在するかどうかを判定する関数)と
ループ関数を活用して、指定したフォルダ内の拡張子が
◆「Excel(.xlsx)」のファイルを1つずつ【展開】→
◆【見出しを除いた表部分をコピー】→
◆【まとめファイルに貼付け】
しています。この作業を指定のファイルに有るExcelファイルが見当たらなくなるまでループで続けています。
サンプルコードの簡単な解説
① どのフォルダ内のExcelにするのかを決めている
[myPath] 部分でフォルダの場所を特定している
② 指定したフォルダ内の拡張子が「Excel(.xlsx)」を全て展開するまで、ループを続けます。(以下の③~⑥をループ)
③ 指定フォルダに有るBookを展開する
④ 展開したBookの1枚目のSheetのデータ範囲全体を指定
⑤ ④で指定した範囲の最下段1行を範囲から除き、さらにその範囲1行下にずらす
⑥ ⑤の範囲をコピー、まとめBookの最下段+1行(書き始め位置)に貼付け、展開したBookを閉じる
⑦ループを抜けた後、最後に、列幅の最適化調整をする
以上になります。
何かの参考になれば幸いです。