あるフォルダ配下に複数のエクセルがあります。
これを以下のように１つのシートに統合したいのです。
>For Each sh In wb.Worksheets
を
>For Each sh In wb.Worksheets("Sheet2")
としましたが，エラーで動きませんでした。
いろいろやってみたり調べましたが頓挫しております。
よろしくお願い致します。
条件
科目名（A科目 B科目 C科目）のタイトル部分は不要
フォルダ配下にあるすべてのエクセルファイル内のある特定のシートの内容を統合したい。シート名は共通のものをつけています。
（ファイル内の全てのシートを結合する方法は分かったのですが，ある特定のシートを指定しての統合ができません。）
<１．ｘｌｓ>
(sheet1)
A科目 B科目 C科目
390,200 426,200 801,600
(sheet2)
A科目 B科目 C科目
5,000 6,000 7,000
<２．ｘｌｓ>
(sheet1)
A科目 B科目 C科目
140,500 333,200 1,400
(sheet2)
A科目 B科目 C科目
8,000 9,000 10,000
↓
＜統合.csv＞
390,200 426,200 801,600
140,500 333,200 1,400
＊以下，現在までにできたVBA
Sub Test()
Dim fn, wb, x, i, n, sh, myPath
myPath = ThisWorkbook.Path & "\"
fn = Dir(myPath & "*.xls") '選択したフォルダ内のExcelファイルを検索します
Do Until fn = "" '全て検索し終えると、fn = Empty となるので、その間以下を実行します
If fn <> ThisWorkbook.Name Then 'ファイルが自分以外なら
Set wb = Workbooks.Open(myPath & fn) '選択したファイルを開きます
For Each sh In wb.Worksheets '各シートごとに
x = sh.Cells(Rows.Count, 1).End(xlUp).Row '最終行取得
For i = 2 To x '2行目から最終行まで以下を実行します
n = n + 1
With ThisWorkbook.Sheets("Sheet1") '転記
.Cells(n, 1) = sh.Cells(i, "A")
.Cells(n, 2) = sh.Cells(i, "B")
.Cells(n, 3) = sh.Cells(i, "C")
End With
Next i
Next sh
wb.Close (False) '選択したファイルを閉じる
End If
fn = Dir() '次のファイルを検索
Set wb = Nothing
Loop '繰り返し
ThisWorkbook.Sheets("Sheet1").Copy
Application.Dialogs(xlDialogSaveAs).Show Arg1:="統合.csv", Arg2:=6
End Sub
お礼
ありがとうございました！無事動きました。 かなり苦しみましたので助かりました。ありがとうございました。