複数エクセルブックを一つにするマクロが知りたいです

質問

フォルダ内に「01.xlsx」「02.xlsx」…「10.xlsx」という10個のブックがあります。
各ブックの中には、ブック名に対応した形で「01」「02」…「10」というシート名のシートが一つだけ入っています。

同フォルダ内に「matome.xlsx」というブックを用意して、マクロ処理をかけることで、「matome.xlsx」の中に「01」「02」…「10」のみの10個のシートが入った状態にしたいです。
マクロ処理をかける前の「matome.xlsx」のシートには、「sheet1」という、シートが一つだけ入っている状態です。

仕事のデータをまとめるのに、困っています。。。
何かいい方法はありますでしょうか。
マクロに詳しい方、お教えいただければ幸いですm(＿ ＿)m

回答No.2

keithin · ベストアンサー

○01から10まで決め打ちマクロ
　マクロはmatomeブックに登録してある
　matomeブックは01から10ブックと同じフォルダに保存しておく
　matomeブックは，「マクロ有効ブック(.xlsm)」で保存しておく

sub macro1()
　dim myPath as string
　dim i as long

　mypath = thisworkbook.path & "\"

　application.screenupdating = false
　application.displayalerts = false
　for i = 1 to 10
　　workbooks.open mypath & format(i, "00") & ".xlsx"
　　activeworkbook.worksheets(1).move after:=thisworkbook.worksheets(thisworkbook.worksheets.count)
　next i

　thisworkbook.worksheets(1).delete
　application.displayalerts = true
　application.screenupdating = true
end sub

○一般化
　matomeブックとは別にマクロブック(.xlsm)を用意する
　マクロブックは01から10ブックと同じフォルダに保存しておく
　マクロを含まないmatome.xlsxを保存する

sub macro2()
　dim myPath as string
　dim myFile as string
　dim flg as boolean
　dim w as workbook

　mypath = thisworkbook.path & "\"
　myfile = dir(mypath & "*.xls*")

　application.screenupdating = false
　application.displayalerts = false
　do until myfile = ""
　　if myfile <> thisworkbook.name and myfile <> "matome.xlsx" then
　　　workbooks.open mypath & myfile
　　　if not flg then
　　　　set w = activeworkbook
　　　　flg = true
　　　else
　　　　activeworkbook.worksheets(1).move after:=w.worksheets(w.worksheets.count)
　　　end if
　　end if
　　myfile = dir()
　loop

　w.saveas mypath & "matome.xlsx"
　application.displayalerts = true
　application.screenupdating = true
end sub

お礼

ご回答いただき、ありがとうございます！！m(_ _)m
行いたかった処理ができ、かなりの時間短縮になりました！！
01～10だけでなく、一般化もお教えいただき、ありがとうございますm(＿ ＿)m
応用させて、今後にも活用させていただきます！
本当にありがとうございました！！m(＿ ＿)m

回答No.1

tomi5957

こんなフリーソフトがありますよ。

参考URL：

http://www.ozsystem.jp/frdatn/atn_top.htm