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
お礼
とても早い回答、ありがとうございます。 microsoft office2007用の辞書ツールがインストールされてました。 これが原因である可能性があるんですね。