今回紹介するのは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のみになります)
ひとつずつ発注書を開いてデータをコピペして・・・
考えるだけでめんどくさいですね。
単純作業はどんどんコンピューターに任せちゃいましょう!
事務作業が少しでも楽になりますように。この記事がそのお役に立てたら嬉しいです。
お問い合わせ、お仕事のご依頼などがありましたら下記のお問い合わせフォームからご連絡お願いします。
お問い合わせフォーム
コメント
ブログとYouTube参考にさせていただいて勉強しております。初心者です。
サンプルコード2にて縦長のデータで行ではなく列を+1ずつして転記していきたい場合、Columns.CountやEnd(xlToLeft)に置き換えればよいのかと思ったのですが、そうするとA列にずっと転記をつづけていってしまい私のわかる範囲ではお手上げになってしまいました。最終列に+1していきたい場合最終行とは勝手が違うのでしょうか?
コメントありがとうございます。
もともとのコードに穴がありますね。ごめんなさい。
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
の箇所に追加が必要だとは思いもよらなかったです。
今後も参考にさせていただきます。
ご丁寧にありがとうございました。
解決したようで良かったです。ご報告ありがとうございます!
[…] 【エクセルVBA】フォルダ内の全ファイルのデータを取り出す […]