複数の同じフォーマットのファイルを新しいブックで一つのシートにまとめる方法

仕事で、各部署から送られてきた、同じフォーマットのファイル（シート1にのみデータ有）が50個近くあります。
それを新しいブックで一つのシートにまとめなくてはいけません。
地道にコピペするのは時間がかかるのでマクロで処理を行いたいと思います。
マクロでの処理方法ご存知の方、処理方法の載っているサイトをご存知の方、もしくはマクロより簡単な方法がありましたら教えてください。

あと、逆に一つのシートをいくつかのファイルに振り分けていく方法もご存知でしたら教えて下さい。
よろしくお願いします。

No.3 ベストアンサー 回答者： hallo-2007 回答日時： 2008/08/03 20:55

すみません。

質問を勘違いしていました。
>新しいブックで一つのシートにまとめなくてはいけません
でしたね。
Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf
Sheets("Sheet1").Range("A1:J1000").Copy
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Workbooks(buf).Activate
Application.CutCopyMode = False
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub
で試してみてください。使い方などは
http://oshiete1.goo.ne.jp/qa4225063.html
を参照してみてください。同じ質問があったので気がつきました。

この回答へのお礼

ありがとうございました。
同じ質問を捜していくつか似たようなものがあったんですけど、少しニュアンスが違ってたので質問させていただきました。
こちらにもあったんですね。
凄く助かります。早速試してみます。

お礼日時：2008/08/06 22:55

No.2 回答者： hallo-2007 回答日時： 2008/08/02 10:48

ブックをまとめる方のVBAです

A1セルに　ファイルのあるパスを入れておきます
対象はエクセルのファイルにしてあります。
複数のシートの場合も対応します。

Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Range("A1").Value & "\*.xls")
Do While buf <> ""
i = i + 1
Workbooks.Open Worksheets(1).Range("A1").Value & "\" & buf
For j = 1 To Worksheets.Count
ThisWorkbook.Worksheets(1).Cells(i + 1, j + 1) = Sheets(j).Name
Worksheets(j).Copy After:=ThisWorkbook.Worksheets(1)
Workbooks(buf).Activate
Next
Worksheets(1).Cells(i + 1, 1) = buf
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub

No.1 回答者： esterhazy 回答日時： 2008/08/02 02:13

まず、複数のBOOKをひとつにまとめます。

次に、↓このサイトに、複数シートをひとつのシートにまとめるマクロの
サンプルエクセルがダウンロードできますので、
http://www.relief.jp/itnote/archives/001729.php
そのエクセルを起動した状態で、「ツール」「マクロの有効」でマクロを有効にし、マクロを実行すると、シートはまとまります。

また、私自身は使用したことがありませんので、使い勝手等はまったくわかりませんが、複数のブックを1つのブックにまとめたり、1つのブックを、シートごとに別々のブックに分割するフリーソフトが掲載されています。↓
http://www.vector.co.jp/soft/win95/business/se30 …

この回答へのお礼

おおお～、こちらも使えそうですね。
ありがとうございます。
凄く助かりました。

お礼日時：2008/08/06 22:56