• ベストアンサー

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

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

質問者が選んだベストアンサー

  • ベストアンサー
  • ham_kamo
  • ベストアンサー率55% (659/1197)
回答No.2

抽出先のブックを同じフォルダに作成し、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個もファイルがあるとかなり時間がかかると思いますが、何個のファイルを処理したかは左下に表示するようにしているので、ある程度目安になると思います。 あと、フォルダ内のブックを開いてはコピーして閉じ、ということを繰り返しているので、実行中はタスクバーがちらちらしますが、気にしないでください。

akikoiw
質問者

お礼

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

その他の回答 (2)

  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.3

エラー処理などはしていないので・・・。 対象のファイルとは別のフォルダにブックを作成して実行して下さい。 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

akikoiw
質問者

お礼

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

  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.1

>それぞれのファイルの例えば3~5行目だけを抽出し 特定のシートのみですか?それとも全てのシートから抽出するのでしょうか? そして、全てのデータを1枚のシートに貼付けるのですか?それとも同一名のシートに貼付けるのでしょうか?

akikoiw
質問者

補足

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

関連するQ&A