VBAに詳しい方教えてください。フォルダ内のxlsxファイルのデータを1シートにまとめたく以下のVBAを作成しました。A列に転記元ファイル名が転記されるのですが、ファイル名だけが重複して転記されてしまいます。どのように修正すれば良いか教えて頂きたいです。よろしくお願いいたします。Sub 集計() Dim A, B, C Set B = ThisWorkbook.Worksheets(\u0026quot;まとめ\u0026quot;) 'フォルダ内のブック名を取得 C = Dir(ThisWorkbook.Path \u0026amp; \u0026quot;\\\u0026quot; \u0026amp; \u0026quot;*.xlsx\u0026quot;) Do While C \u0026lt;\u0026gt; \u0026quot;\u0026quot; 'ブックを開く Workbooks.Open ThisWorkbook.Path \u0026amp; \u0026quot;\\\u0026quot; \u0026amp; C 'データ部分を取得 With ActiveWorkbook.Worksheets(1).Range(\u0026quot;A1\u0026quot;).CurrentRegion A = .Rows(\u0026quot;2:\u0026quot; \u0026amp; .Rows.Count) End With 'データを入力 B.Cells(Rows.Count, \u0026quot;B\u0026quot;).End(xlUp).Offset(1, 0).Resize(UBound(A, 1), 17) = A 'ブック名を入力 B.Cells(Rows.Count, \u0026quot;A\u0026quot;).End(xlUp).Offset(1, 0).Resize(UBound(A, 1)) = ActiveWorkbook.Name ActiveWorkbook.Close False 'ブックを閉じる C = Dir() '次のブック名を取得 Loop End Sub

変数名はどういう項目か想像がつく方がいいと思うので変更させてもらいました。

オーバーフローは多分

A = .Rows(\u0026quot;2:\u0026quot; \u0026amp; .Rows.Count)

で出たのではないかと思います。行全体を設定しているので。

後のコード

B.Cells(Rows.Count, \u0026quot;B\u0026quot;).End(xlUp).Offset(1, 0).Resize(UBound(A, 1), 17) = A

を見ると17列をコピーすればいいと思うので、ここも変更しました。



Sub test()

Dim wb As Workbook

Dim sh As Worksheet

Dim fpath As String, fname As String

Dim r As Long

Dim A As Variant

Application.ScreenUpdating = False

Set sh = ThisWorkbook.Worksheets(\u0026quot;まとめ\u0026quot;)

fpath = ThisWorkbook.Path \u0026amp; \u0026quot;\\\u0026quot;

fname = Dir(fpath \u0026amp; \u0026quot;*.xlsx\u0026quot;)

Do While fname \u0026lt;\u0026gt; \u0026quot;\u0026quot;

Set wb = Workbooks.Open(fpath \u0026amp; fname)

With wb.Worksheets(1)

r = .UsedRange.Rows.Count

A = .Range(.Cells(2, 1), .Cells(r, 17))

sh.Cells(Rows.Count, \u0026quot;A\u0026quot;).End(xlUp).Offset(1, 0).Resize(UBound(A)) = fname

sh.Cells(Rows.Count, \u0026quot;B\u0026quot;).End(xlUp).Offset(1, 0).Resize(UBound(A), 17) = A

End With

wb.Close False

fname = Dir()

Loop

Application.ScreenUpdating = True

End Sub