【エクセルVBA】フォルダ内の全ファイルのデータを取り出す

VBA

※本サイトはアフィリエイト広告を利用しています。

今回紹介するのはVBAを書いていてよく使う機能です。

事務をしていると「ファイルを開いてデータをコピペする」という作業を連続で10ファイル分ぐらいすることありませんか?
例えば発注書の整理とか。
お客さんから届いた多量な発注書を、一瞬で一覧表にできちゃいます。
「誰が」「いつ」「何を」「何個」注文したかを一覧表にしないと、いつまでにどの商品を何個仕入れなきゃいけないかが分からないですよね。
このコードを書いたのも、上記のようなご依頼がもとになってます。

ひとつずつ発注書を開いてデータを転記して…
がボタンをクリックするだけで一瞬で終わる、便利なVBAです。

サンプルコード1

Sub OpenCSVfile()
   Dim buf As String
   Dim Path As String
   
   '  このファイルがあるフォルダのパスを取得
   Path = ThisWorkbook.Path
   
   'CSVファイルだけを取ってくる
   buf = Dir(Path & "\" & "*.csv")
   '該当するファイルが無くなるまでループ
   Do While buf <> ""
       
       '見つけたファイルを開く
       Workbooks.Open Path & "\" & buf
       
       'シートをまるごとコピー
       Worksheets(1).Copy After:=ThisWorkbook.Worksheets("Sheet1")
               
       'CSVファイルを閉じる
       Workbooks(buf).Close
       
       '次のファイルを取得
       buf = Dir()
   Loop
End Sub

dirとDo Whileを使って、指定したフォルダに入っているファイル(今回の例では拡張子がCSVのもの、と指定しています)をひとつずつ開いています。
こちらのコードでは、シードごとまるっとコピーしています。
実際に依頼を受けて作ったコードでは、コピーした後で必要なセルだけを転記するというコードもあったのですが、今回の説明では要点だけに絞りたかったので省略しました。

サンプルコード2

コードの解説をしたYouTubeの動画の方で、シートごとではなく一部のデータだけコピーする方法が知りたいとのリクエストをいただきました。
リクエストにお答えして、サンプルコードを載せておきます。

Sub OpenCSVfile()
  Dim buf As String
  Dim Path As String
  Dim LastRow As Long
    
  '  このファイルがあるフォルダのパスを取得
  Path = ThisWorkbook.Path
  
  'CSVファイルだけを取ってくる
  buf = Dir(Path & "\" & "*.csv")
  '該当するファイルが無くなるまでループ
  Do While buf <> ""
      
      '見つけたファイルを開く
      Workbooks.Open Path & "\" & buf
      
      '開いたCSVファイルのコピーしたい範囲を選択
      Range("A1:F5").Copy
      
      LastRow = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
      
      '貼り付け
      If LastRow = 1 And ThisWorkbook.Worksheets(1).Cells(1, 1) = "" Then '最終行が1の時かつセルA1が空欄の時(→シートに何も書かれていない時)は1行目に転記
        ThisWorkbook.Worksheets(1).Cells(1, 1).PasteSpecial
      Else 'A1セルに既に文字が入っている時は最終行+1行目に転記
          ThisWorkbook.Worksheets(1).Cells(LastRow + 1, 1).PasteSpecial
      End If
      
      'CSVファイルを閉じる
      Workbooks(buf).Close
      
      '次のファイルを取得
      buf = Dir()
  Loop
End Sub


1.開いたCSVファイルのコピーしたい範囲を選択
2.VBAが書いてあるファイルの左端のシートの、最終行の下に貼り付け
この2つがサンプルコード1から変わったところです。

コピーする範囲を変更したい → Range(“A1:F1”)を変える
貼り付ける場所を変更したい → ’貼り付けの部分を変える
貼り付けの形式を変更したい → PasteSpecialの後に「xlPasteValues」をつけると値だけ貼り付けすることも可能です。(値だけ貼り付け、結構よく使いますね)
などを変えて自分用にカスタマイズしてお使いください。

形式の変更ですが、他にも数式を貼り付けたり書式を貼り付けたりなんかもできます。
どのような種類があるかや書き方の説明は割愛しますが、調べていろいろ試してみてください。

動画

どのような動きをするコードか、1行ずつ実行しながら解説しています。(こちらの解説はサンプルコード1のみになります)

フォルダ内のファイルを開いてデータを転記するVBA

ひとつずつ発注書を開いてデータをコピペして・・・
考えるだけでめんどくさいですね。
単純作業はどんどんコンピューターに任せちゃいましょう!

事務作業が少しでも楽になりますように。この記事がそのお役に立てたら嬉しいです。

お問い合わせ、お仕事のご依頼などがありましたら下記のお問い合わせフォームからご連絡お願いします。
お問い合わせフォーム

お問い合わせ、お仕事のご依頼などがありましたら下記のお問い合わせフォームからご連絡ください。
お問い合わせフォーム
VBAの作成であれば50,000円ほどから、自分で使うVBAの書き方で詰まっている方のお手伝いであれば10,000円ほどから承ります。

VBA
スポンサーリンク
スポンサーリンク
りこをフォローする
エクセルVBAの寺子屋

コメント

  1. もとやま より:

    ブログとYouTube参考にさせていただいて勉強しております。初心者です。
    サンプルコード2にて縦長のデータで行ではなく列を+1ずつして転記していきたい場合、Columns.CountやEnd(xlToLeft)に置き換えればよいのかと思ったのですが、そうするとA列にずっと転記をつづけていってしまい私のわかる範囲ではお手上げになってしまいました。最終列に+1していきたい場合最終行とは勝手が違うのでしょうか?

    • りこ riko6v6 より:

      コメントありがとうございます。
      もともとのコードに穴がありますね。ごめんなさい。

      If LastRow = 1 Then ‘最終行が1の時(→シートに何も書かれていない時)は1行目に転記

      If LastRow = 1 And ThisWorkbook.Worksheets(1).Cells(1, 1) = “” Then ‘最終行が1の時かつセルA1が空欄の時(→シートに何も書かれていない時)は1行目に転記
      に修正しました。

      あとは、もとやまさんがおっしゃってるようにColumns.CountやEnd(xlToLeft)に置き換えるのと、
      ThisWorkbook.Worksheets(1).Cells(LastRow + 1, 1).PasteSpecial

      ThisWorkbook.Worksheets(1).Cells(1, LastRow + 1).PasteSpecial
      に変更すれば動くと思います。

      ご参考になれば幸いです!

      • もとやま より:

        早々に返信いただきありがとうございます。
        先ほど動くものになりました!

        If LastRow = 1 Then
        の箇所に追加が必要だとは思いもよらなかったです。

        今後も参考にさせていただきます。
        ご丁寧にありがとうございました。

  2. […] 【エクセルVBA】フォルダ内の全ファイルのデータを取り出す […]

タイトルとURLをコピーしました