EXCELで複数のファイルから抽出

Excelのことで困っています。
何かいい方法があれば教えてください。

同じフォームのエクセルファイルが約1000ファイルあり、それぞれのファイルの例えば3～5行目だけを抽出し、別のの新しいファイルにどんどん貼り付けて3～5行目だけを集めたファイルを作りたいのですが、ファイルの数が多いので、全ファイルを開いてコピペする以外にマクロか何かを使って自動で抽出できるような方法がないかと考えております。
1000個のファイル名は今はばらばらですが、必要であれば0001.xls～1000.xlsなどに変更してもよいです。

どうぞよろしくお願いします。

No.2 ベストアンサー 回答者： ham_kamo 回答日時： 2007/03/15 10:49

抽出先のブックを同じフォルダに作成し、Alt+F11でVBAの画面を開き、左側のツリーからブック名を選択し、右クリックから「挿入」＞「標準モジュール」を選択して、右の画面に以下のマクロをコピーして貼り付けてください。

Sub ファイルから抽出()
　Dim FName As String
　Dim Folder As String
　Dim WB As Workbook
　Dim i As Integer, j As Integer
　Application.ScreenUpdating = False
　Folder = ThisWorkbook.Path & "\"
　i = 1: j = 1
　Worksheets(1).Cells.ClearContents
　FName = Dir(Folder & "*.xls")
　Do While FName <> ""
　　If FName <> ThisWorkbook.Name Then
　　　Workbooks.Open (Folder & FName)
　　　Workbooks(Workbooks.Count).Worksheets(1).Rows("3:5").Copy _
　　　ThisWorkbook.Worksheets(1).Cells(i, 1)
　　　Workbooks(Workbooks.Count).Close
　　　Application.StatusBar = j & "ファイル処理済み"
　　　i = i + 3: j = j + 1
　　End If
　　FName = Dir()
　Loop
　Application.StatusBar = ""
　Application.ScreenUpdating = True
　MsgBox ("完了しました")
End Sub

Alt+F11でExcelの画面に戻ってAlt+F8からマクロを実行してみてください。各ファイルの３行目～５行目がコピーされます。

高速化のために処理中は描画を止めているので、全ての処理が終わった後に画面は表示されます。1000個もファイルがあるとかなり時間がかかると思いますが、何個のファイルを処理したかは左下に表示するようにしているので、ある程度目安になると思います。

あと、フォルダ内のブックを開いてはコピーして閉じ、ということを繰り返しているので、実行中はタスクバーがちらちらしますが、気にしないでください。

この回答へのお礼

初心者の私には、大変わかりやすい説明でありがたかったです。
無事、抽出作業終了しました。大変助かりました。
ありがとうございました。

お礼日時：2007/03/16 19:23

No.3 回答者： hana-hana3 回答日時： 2007/03/15 11:19

エラー処理などはしていないので・・・。

対象のファイルとは別のフォルダにブックを作成して実行して下さい。
WorkPath にファイルのあるフォルダを設定して下さい。

Sub Tenki()

Dim WorkPath As String
Dim TMP As String
Dim MaxRow As Long

Application.ScreenUpdating = False

WorkPath = "C:\パス名を記入"
TMP = Dir(WorkPath & "\*.xls", vbNormal)
MaxRow = 1

Do While TMP <> ""
Workbooks.Open WorkPath & "\" & TMP

Workbooks(TMP).Sheets("Sheet1").Rows("3:5").Copy _
ThisWorkbook.Sheets("Sheet1").Cells(MaxRow, 1)
MaxRow = MaxRow + 3

Workbooks(TMP).Close SaveChanges:=False
TMP = Dir()
Loop

MsgBox "転記が終了しました。"
End Sub

この回答へのお礼

とても参考になりました。
ありがとうございました。

お礼日時：2007/03/16 19:24

No.1 回答者： hana-hana3 回答日時： 2007/03/15 09:03

＞それぞれのファイルの例えば3～5行目だけを抽出し

特定のシートのみですか？それとも全てのシートから抽出するのでしょうか？
そして、全てのデータを１枚のシートに貼付けるのですか？それとも同一名のシートに貼付けるのでしょうか？

この回答への補足

早速ありがとうございます。
sheet1からのみです。
1枚のシートに貼り付けたいです。

よろしくお願いします。

補足日時：2007/03/15 10:14