【VBA】フォルダ内のデータ全てを取得したい。

Question

前提・実現したいこと

フォルダ内のすべてのファイルデータを1シートにまとめたいです。

発生している問題・エラーメッセージ

1ファイル分のデータしか転記が行えません…。
イミディエイトウィンドウには、フォルダ内全てのファイル名が記載されています。

該当のソースコード

Sub データ集約()
 
Dim fso As FileSystemObject
Set fso = New FileSystemObject

Dim f As File
For Each f In fso.GetFolder(ThisWorkbook.Path & "\データ格納先").Files
    Debug.Print f.Path
    With Workbooks.Open(f.Path)
        With .Worksheets(1)
        
        'データの転記
        Dim i As Long
        i = 4
        
        Do While .Cells(i, 1).Value <> ""
        
        wsData.Cells(i, 1).Value = .Cells(4, 1).Value
        wsData.Cells(i, 2).Value = .Cells(4, 2).Value
        
         i = i + 1
        Loop
            
        End With
        .Close
    End With
Next f

End Sub

試したこと

補足情報（FW/ツールのバージョンなど）

かなりのVBA初心者のため、基礎知識もありません……
どなたか教えていただけますと幸いです。

Comments

[mkmigmyuch]

こんばんは。
VBAの部分をcode""でくくると見やすくなり、回答してもらいやすくなりますよ。

[meg_]

コードは「コードの挿入」で記入してください。

> 1ファイル分のデータしか転記が行えません…。
それは最初のファイルですか？

[退会済みユーザー]

mkmigmyuch様、meg_様
ご指摘ありがとうございます！勉強になります(/_;)
修正させていただきました！

> 1ファイル分のデータしか転記が行えません…。
> それは最初のファイルですか？
こちらに関しては、最後のファイルデータが転記されている状態です。

Answer 1

i = 4 と初期値をセットする箇所を、処理の先頭に移動するとよいのではないかと思います。

（そうしないと、新しいファイルを処理するたびに、前の結果を上書きする形で４行目から出力されてしまいます。）

Comments

[退会済みユーザー]

jinoji様
ご回答いただき、ありがとうございます！
i = 4 と初期値をセットする箇所を先頭へ移動させてみましたが、やはり同様に1ファイル分のデータ転記しか行えませんでした…＞＜

[jinoji]

移動させた先は For Each文より前ですか？後ですか？

[jinoji]

というか、なんかやりたいことがわからなくなりました。
順番に開くファイルのどのセルを、どこに転記したいのでしたっけ？
各ファイルのA4セルとB4セルを、wsDataシートのA列、B列に転記？

[退会済みユーザー]

ご回答ありがとうございます！！
For Eachより前に移動させて、もう一つ値の変数をセットしたら全てのファイルのデータを取得できました！！
本当にありがとうございます！！

Answer 2

可能性として

１．フォルダ内のファイルに Excelファイルではないものが含まれている。
２．転記元のExcelファイルの転記元のセルに値が無い
３．実は、転記処理でエラーが出ているが、（エラートラップ処理が記載してあって）気づかない。

というのが挙げられます。

ただし、現在の質問文に記載されたコードは、実際のコードを完全に網羅していない可能性があります。

処理の内容

フォルダThisWorkbook.Path & "\データ格納先"に保存されているファイルを
すべてExcelファイルとみなしてWorkbooks.Open(f.Path)で開きます。

開いたファイルのセルの 4行目1列目、4行目2列目から
変数 wsData で指定したワークシートへセルの値を転記しています。

が、どういうわけか、変数 wsData へワークシートオブジェクトをセットしたはず箇所がどこにも載っていません。

wsData.Cells(i, 1).Value = .Cells(4, 1).Value
wsData.Cells(i, 2).Value = .Cells(4, 2).Value

記載された内容を、ほかのPCで実行すると、オブジェクトが未定義でエラーが発生します。
質問文に記述があるのではないでしょうか？

追記
jinoji さんのご指摘通り、for ループ内に、転記先の行の位置を決定している変数 i があるため、ファイルが変わるたびに　4行目に戻っています。
このため、最後のファイルのみ転記された（ように見える）状態になっています。

        Dim i As Long
        i = 4

for ループの外に移動させましょう。
こんな感じで

Dim i As Long
i = 4

Dim f As File
For Each f In fso.GetFolder(ThisWorkbook.Path & "\データ格納先").Files

Comments

[退会済みユーザー]

Yoshi88さま
ご回答ありがとうございます！！
ご丁寧に説明してくださり、大変ありがたいです！

１．フォルダ内のファイルに Excelファイルではないものが含まれている。
２．転記元のExcelファイルの転記元のセルに値が無い

上記2点に関しては問題なさそうです。

３．実は、転記処理でエラーが出ているが、（エラートラップ処理が記載してあって）気づかない。

こちらは私の知識がなさすぎて転記処理でエラーが出ているのかどうか判断ができかねます…。
すみません……。
ただ可能性としては1ファイル分のデータは転記できているので、LOOP処理がうまくいっていないのかと思っています…。

コードは記載しているものが全てですが、オブジェクト未定義のエラーは私の画面では出ていないと思います＞＜

[Yoshi88]

そうですか、モジュールの外に、グローバル変数で指定されているのかもしれませんね。では、まずは jinoji さんが指摘された部分を反映しましょう。　jinoji さんの指摘どおり、現在ではファイルが変わると　4行目に戻って（上書き）しています。結果、最後のファイルのみ更新しているように見えているはずです

[退会済みユーザー]

ご回答ありがとうございます！！
シートのオブジェクト名をwsDataに変更しておりました、、
ご丁寧に回答いただきまして、本当にありがとうございました！！
解決いたしました(ToT)