Excel。マクロ043。フォルダー内のブックを新しいブックにコピーしてまとめてみる
＜マクロ：Excel VBA＞
日ごろ、面倒だなぁ～という処理をマクロで実行できたらなぁ～と思うことって、結構あるのですが、今回は、フォルダー内にあるブックのシートを新しいシートにコピーしたいというケースをご紹介してきます。フォルダーに、次のようなファイル（ブック）があります。
集計.xlsmには、Excel VBAを作っていくファイルです。
現在は、集計と抽出というシートが2枚あるだけです。
各店舗のファイルも確認しておきましょう。
このように、各ブックには、シートがあって、このシートを集計という新しいブックにまとめたいわけです。
通常処理で考えると、シート名の上で右クリックして、「シートの移動またはコピー」を使って、一つずつ設定しなければいけません。
2～3個のブックだったら、根性で処理してもいいのですが、10個とかになると面倒以外の何物でもありません。
それでは、Excel VBAで作っていきます。
Sub ブック結合()
Dim f_name As String
f_name = Dir("C:\Users\店舗データ\*.xlsx")
Do While f_name <> ""
Workbooks.Open "C:\Users\" & f_name
Workbooks(f_name).Worksheets(1).Copy before:=ThisWorkbook.Worksheets(1)
ThisWorkbook.Worksheets(1).Name = Replace(f_name, ".xlsx", "")
Workbooks(f_name).Close False
f_name = Dir()
Loop
End Sub
たったこれだけですが、これで、一つのブックにまとめることができます。
まずは、実行してみましょう。
このように、集計.xlsmにまとめることができました。
作業効率も一気に改善して、『時短』することができちゃいます。
それでは、プログラム文を確認しておきましょう。
それぞれのファイル名を入れる変数が必要なので、f_nameというのを用意しました。
Dim f_name As String
そのf_nameという変数に、データの場所（パス）を含めたファイル名を格納します。
f_name = Dir("C:\Users\店舗データ\*.xlsx")
ただし今回は、Excelファイルをまとめるようにしますので、*.xlsxとワイルドカードを使います。
そして、Excelファイルなので、拡張子は、xlsxとします。
なので、今回実行するときの注意点なのですが、該当以外の拡張子がxlsxのファイルをいれておくと、マクロが正常に稼働することができません。
それと、"C:\Users\店舗データ\ は、今回実行しているPCの環境なので、実際には、それぞれの環境のパスを入力設定する必要がありますので、ここも注意してください。
フォルダー内に該当のファイルがある間は処理を繰り返させたいので、DO While文をつかって繰り返し処理を設定してきましょう。
Do While f_name <> ""～Loop
これで、該当のデータがある間は繰り返し処理を行うことができます。
この繰り返し処理の中が、主な処理にあたります。
Workbooks.Open "C:\Users\" & f_name
これは、該当のファイルを開きます。
Workbooks(f_name).Worksheets(1).Copy before:=ThisWorkbook.Worksheets(1)
開いたファイルのシートをコピーして、ThisWorkbook（集計ファイル）のシートのbefore（前）に貼り付けを行う処理をする構文です。
ThisWorkbook.Worksheets(1).Name = Replace(f_name, ".xlsx", "")
ついでなので、挿入（コピー）したシート名をファイル名と同じように変更しておきます。
Replace(f_name, ".xlsx", "")は、Relace関数を使うことで、xlsxという文字を空白に置き換える処理をしています。
Workbooks(f_name).Close False
コピーが終わりましたので、開いているファイルを閉じます。Falseは、メッセージなしで閉じることができます。
f_name = Dir()
次のファイル名のための準備の構文ですね。一度、f_nameをクリアーしておきます。
このように短めの構文で『時短』できるところが、マクロ：Exce VBAの醍醐味ですね。
