VBA シート指定の結合
あるフォルダ配下に複数のエクセルがあります。
これを以下のように1つのシートに統合したいのです。
>For Each sh In wb.Worksheets
を
>For Each sh In wb.Worksheets("Sheet2")
としましたが,エラーで動きませんでした。
いろいろやってみたり調べましたが頓挫しております。
よろしくお願い致します。
条件
科目名(A科目 B科目 C科目)のタイトル部分は不要
フォルダ配下にあるすべてのエクセルファイル内のある特定のシートの内容を統合したい。シート名は共通のものをつけています。
(ファイル内の全てのシートを結合する方法は分かったのですが,ある特定のシートを指定しての統合ができません。)
<1.xls>
(sheet1)
A科目 B科目 C科目
390,200 426,200 801,600
(sheet2)
A科目 B科目 C科目
5,000 6,000 7,000
<2.xls>
(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
お礼
どひゃーーー!まさかブログ記事にして回答していただけるとは思いませんでした!!( ゜д゜)超ヴィックリ&ありがたみでベストアンサーにさせていただきまあああああす!!!!!ありがとうございました!!ほかの記事も参考にさせていただきます!m(_ _)m