学生に提出してもらったExcelファイルを集計するような時
いちいちファイルを開いて、確認するのは面倒。
その際、一つのブックにワークシートを全部集めてしまえば、
串刺し計算やら分析やら色々と加工が容易くなる。
そんな時に使えるマクロ。

ファイルはすべて同じフォルダに入れてください。
集計用のシートを一枚作成しておき、以下のマクロを実行。
集計用シートの後ろにすべてのシートが集まってくれます。
集計終わると、何コのブックを集めたかもメッセージボックス
で表示してくれます。

ファイル数は何個でもOKのはずですが、私が実際に試したのは30コまでです。
------------------------------
Sub consolid()
Application.ScreenUpdating = False '画面更新を一時停止
Set mb = ThisWorkbook
myfdr = ThisWorkbook.Path
fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelファイルを検索
Do Until fname = Empty '全て検索し終えると、fname = Empty となるので、その間以下を実行
If fname <> mb.Name Then 'ファイル名がこのファイルじゃなければ
Set wb = Workbooks.Open(myfdr & "\" & fname) '選択したファイルを開く
wb.Worksheets(1).Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてまとめ用ブック末尾に置く
wb.Close '選択したファイルを閉じる
n = n + 1 'ブック数をカウント
End If
fname = Dir '選択したフォルダ内の次のExcelファイルを検索します
Loop '繰り返す
Application.ScreenUpdating = True '画面更新一時停止を解除
MsgBox n & "件のブックをまとめましました。"
End Sub
------------------------------

一応、自己責任で自由にご活用ください。m(_ _)m
タグ ：
#Excel