複数のブックから、特定文字のシートをあつめるには?

質問

複数のエクセルブックがあり、シートがたくさんあります。ブック名もバラバラで、シート名は「○○(日本人)」、「××(日本人)」、「○○(外国人)」、「××(外国人)」……とあります。
このシートを、日本人、外国人それぞれエクセルブックのシートごとにあつめたいです。
エクセルマクロを使って行いたいのですが、どうしたらいいかわかりません。
どなたか教えていただけないでしょうか?

回答No.1

keithin · ベストアンサー

マクロブックを１冊用意する
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim a as variant
　dim myFile as variant
　dim myBook as workbook
　dim w as worksheet
　dim wJ as workbook
　dim wF as workbook

’複数のエクセルブック
　a = application.getopenfilename(title:="select files", multiselect:=true)
　if not isarray(a) then exit sub

’指定のブックごとに
　for each myfile in a
　　set mybook = workbooks.open(filename:=myfile)

　’シートごとに
　　for each w in mybook.worksheets

　　　if w.name like "*日本人*" then
　　’日本人シート
　　　　if wj is nothing then
　　　　　w.copy
　　　　　set wj = activeworkbook
　　　　else
　　　　　w.copy after:=wj.worksheets(wj.worksheets.count)
　　　　end if

　　　elseif w.name like "*外国人*" then
　　’外国人シート
　　　　if wf is nothing then
　　　　　w.copy
　　　　　set wf = activeworkbook
　　　　else
　　　　　w.copy after:=wf.worksheets(wf.worksheets.count)
　　　　end if
　　　end if
　　next
　　mybook.close savechanges:=false
　next
end sub

ファイルメニューから終了してエクセルに戻る
ＡＬＴ＋Ｆ８でマクロを実行する

お礼

すごいです!!!
途中、(w.copy after:=wj.worksheets(wj.worksheets.count)ここで、中断しましたが継続の三角マークを押したら、最後までいきました。
なぜ中断したか、疑問は残りますが、シートの数が多すぎたのでしょうか?
しかし、綺麗に日本人、外国人のエクセルブックに分けられました。
気持ちよかったです。ありがとうございました。