- ベストアンサー
EXCELで複数のファイルから抽出
Excelのことで困っています。 何かいい方法があれば教えてください。 同じフォームのエクセルファイルが約1000ファイルあり、それぞれのファイルの例えば3~5行目だけを抽出し、別のの新しいファイルにどんどん貼り付けて3~5行目だけを集めたファイルを作りたいのですが、ファイルの数が多いので、全ファイルを開いてコピペする以外にマクロか何かを使って自動で抽出できるような方法がないかと考えております。 1000個のファイル名は今はばらばらですが、必要であれば0001.xls~1000.xlsなどに変更してもよいです。 どうぞよろしくお願いします。
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
抽出先のブックを同じフォルダに作成し、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からマクロを実行してみてください。各ファイルの3行目~5行目がコピーされます。 高速化のために処理中は描画を止めているので、全ての処理が終わった後に画面は表示されます。1000個もファイルがあるとかなり時間がかかると思いますが、何個のファイルを処理したかは左下に表示するようにしているので、ある程度目安になると思います。 あと、フォルダ内のブックを開いてはコピーして閉じ、ということを繰り返しているので、実行中はタスクバーがちらちらしますが、気にしないでください。
その他の回答 (2)
- hana-hana3
- ベストアンサー率31% (4940/15541)
エラー処理などはしていないので・・・。 対象のファイルとは別のフォルダにブックを作成して実行して下さい。 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
お礼
とても参考になりました。 ありがとうございました。
- hana-hana3
- ベストアンサー率31% (4940/15541)
>それぞれのファイルの例えば3~5行目だけを抽出し 特定のシートのみですか?それとも全てのシートから抽出するのでしょうか? そして、全てのデータを1枚のシートに貼付けるのですか?それとも同一名のシートに貼付けるのでしょうか?
補足
早速ありがとうございます。 sheet1からのみです。 1枚のシートに貼り付けたいです。 よろしくお願いします。
お礼
初心者の私には、大変わかりやすい説明でありがたかったです。 無事、抽出作業終了しました。大変助かりました。 ありがとうございました。