月別フォルダーのブックを順に開いて一覧表を作成するには?

Question 65.1   Previous Next
はじめまして。過去の質問等を見てもわからないので教えてください。Excel2003を使用しています。
複数のファイルのデータを別のファイルに集計する方法です。
・フォルダーの中にさらに月ごとにフォルダーを作って、エクセルファイルを保存しています。
・それを開いて、別のファイルに月ごとのデータで一覧表を作りたいのですが、やり方がわかりません。

ひとつのファイルを開いて、シートの一番上の欄に、マクロを使って入力することはできます。ファイルの名前を指定すればいいことなので。 ただ、複数ある場合に、そしてシートの上から順番に並べていく場合に、その方法がわからないので教えてください。 よろしくお願いします。
Answer   Copyright (C) 2004.1.23 永井善王
ひとつできたなら続けて2~3個、自動記録してみれば考えやすかったでしょうに。
質問文だけでは詳しい仕様がわかりませんから勝手に想像して、代わりにやってみましょうか。
 [第1図] ファイルの状態


「A」というフォルダーの中にサブフォルダー「1
月」、「2月」、「3月」があります。(4~12月は省略)
 [第2図] 1月の 実績.xls

 2月の 実績.xls

 3月の 実績.xls
 [第3図] 一覧表.xls

各月の「実績.xls」から、「りんご」の数量と金額(B2:C2セル)をコピーして、この「一覧表.xls」に貼り付けます。
サブフォルダー「1月」、「2月」、「3月」の中には
[第2図] のとおり同一レイアウトの「実績.xls」
があり、データ(数量・金額)だけが異なると
します。

以上を自動記録すると下図のようなマクロができます。 (「一覧表.xls」に記録した。行番号とコメントは筆者が加筆)
Sub Macro1()
11  Range("B2:C13").Select
12      Selection.ClearContents
 1月分の処理
31  ChDir "C:\A\1月"
32  Workbooks.Open Filename:="C:\A\1月\実績.xls"
33  Range("B2:C2").Select
34      Selection.Copy
35      ActiveWindow.Close
36  Range("B2").Select
37      ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, _
            DisplayAsIcon:=False
 2月分の処理
51  ChDir "C:\A\2月"
52  Workbooks.Open Filename:="C:\A\2月\実績.xls"
53  Range("B2:C2").Select
54      Selection.Copy
55      ActiveWindow.Close
56  Range("B3").Select
57      ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, _
            DisplayAsIcon:=False
 3月分の処理
71  ChDir "C:\A\3月"
72  Workbooks.Open Filename:="C:\A\3月\実績.xls"
73      Range("B2:C2").Select
74      Selection.Copy
75      ActiveWindow.Close
76  Range("B4").Select
77      ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, _
            DisplayAsIcon:=False
End Sub
3カ月分処理するための 3セットのコード(31~37、51~57、71~77行目)ができました。
見比べるとわかりますが月により相違があるところは、
 ・31、51、71行目と 32、52、72行目の "" の中にある
123
 ・36、56、76行目の "" の中にある
234 の3カ所だけです。

ということは、31~37行目のコードを月に応じて処理可能なように修正すれば、51~77行目のコードが不要になります。 まずは不要なコードを削除してから、1月から 12月まで繰り返し処理するための For...Next文を挿入してみましょう。(下図30、38行目)
Sub Macro1_a()
11  Range("B2:C13").Select
12      Selection.ClearContents
 1月分の処理
30  For 月 = 1 To 12
31      ChDir "C:\A\1月"
32      Workbooks.Open Filename:="C:\A\1月\実績.xls"
33      Range("B2:C2").Select
34          Selection.Copy
35          ActiveWindow.Close
36      Range("B2").Select
37          ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, _
                DisplayAsIcon:=False
38  Next
End Sub
続いて、"" の中の文字列を上記の変数「月」を利用するコードに書き換えます。(下図31、32、36行目)
Sub Macro1_b()
11  Range("B2:C13").Select
12      Selection.ClearContents
 1月分の処理
30  For 月 = 1 To 12
31      ChDir "C:\A\" & 月 & "月"
32      Workbooks.Open Filename:="C:\A\" & 月 & "月\実績.xls"
33      Range("B2:C2").Select
34          Selection.Copy
35          ActiveWindow.Close
36      Range("B" & 月 + 1).Select
37          ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, _
                DisplayAsIcon:=False
38  Next
End Sub
修正したマクロをこの段階で実行してみましょう。

すると右図のように、[パスが見つかりません]の実行時エラーが表示されるはずです。

原因究明のため、[デバッグ]ボタンをクリックします。

すると、VBE画面に下図のように黄色の矢印と網掛けで、不具合カ所が表示されます。

そこで左図のように、マウスポインタを変数「月」に合わせると 「月=4」と表示されるので、サブフォルダー「4月」に
ChDir しようとして見つからないからだということが分ります。
エラーの原因としては、追加した For...Next文が無条件で 1月から12月までを繰り返し処理しますが、未来分のサブフォルダーはまだ作ってないとか、作ってあるが 「実績.xls」 が作ってないという場合もあるでしょう。
とりあえず、VBE画面の[リセット]ボタンをクリックして中止し、下図のとおり
エラー処理 のコードを 4行追加します。
Sub Macro1_c()
11  Range("B2:C13").Select
12      Selection.ClearContents
 1月分の処理
30  For 月 = 1 To 12
        On Error GoTo 終了処理
31      ChDir "C:\A\" & 月 & "月"
32      Workbooks.Open Filename:="C:\A\" & 月 & "月\実績.xls"
        On Error GoTo 0
33      Range("B2:C2").Select
34          Selection.Copy
35          ActiveWindow.Close
36      Range("B" & 月 + 1).Select
37          ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, _
                DisplayAsIcon:=False
38  Next
終了処理:
    On Error GoTo 0
End Sub
サンプルファイルのダウンロードは ここをクリック (YNxv9292.lzh 26KB)
※ 一旦、ハードディスクに保存し、解凍すると 「A」フォルダーができるので、それを 「C:\」 へ移動させてください。その中の 「一覧表.xls」にあるマクロを試せます。
関連ページ:選択したフォルダー内の全てのブックを開いて作業するには
参考図書: Excel VBAマクロ組み方講座 実践編第1章6 指定フォルダー内の全てのブックを順に開く

Excel VBA Macro