複数ブックへ一括コピー

質問

150個ぐらいのエクセルファイルがあります。
スタイルはすべて同じで、特定のシートを別ファイルに用意したシート（エクセル表）で書き換えたいと思っています。
マクロの作成でテンプレファイルの読み込みから目的ファイルへの貼り付けをやってみて、WEBを参考にマクロを作ってみましたが、テストでエラー：オブジェクトが指定されていないとか出てしまい、さっぱりわかりません。

貼り付け元ファイル（テンプレ）は1つです。
貼り付け先ファイルは1つの元フォルダにフォルダでさらに分類されており、最大で3階層あります。

貼り付け元ファイルにあるシート（シート名：TITLE）を別のファイルの同じシートに貼り付けます。
シート名は1つだけです。
テンプレと目的ファイルのスタイルはまったく同じです。

どなたかよろしくお願いできないでしょうか。

以下に（失敗している）マクロを添付します。

----------------

Sub Macro2()
'
' Macro2 Macro

Workbooks.Open Filename:= _
"C:\Users\aaa\aaa.xls"
Sheets("TITLE").Select
Cells.Select
Selection.Copy

Dim fol As String
Dim f As String
Dim wb As Workbook
fol = "D:\working"
f = Dir(fol & "\*.xls")
Do While f <> ""
Set wb = Workbook.Open(fol & "\" & f)

Sheets("TITLE").Select
Cells.Select

ActiveSheet.Paste

ActiveWorkbook.Save

wb.Close
f = Dir()
Loop
Set wb = Nothing '変数の解放
End Sub

回答No.1

keithin · ベストアンサー

こんなカンジ。

sub macro1()
　dim myPath as string
　dim myFile as string

’初期化
　workbooks.open "c:\Users\aaa\aaa.xls"
　mypath = "c:\working\"
　myfile = dir(mypath & "*.xls")

’開いてコピー貼り付けて保存して閉じる
　do until myfile = ""
　　workbooks.open mypath & myfile
　　workbooks("aaa.xls").worksheets("TITLE").cells.copy destination:=workbooks(myfile).worksheets("TITLE").range("A1")
　　workbooks(myfile).close savechanges:=true
　　myfile = dir()
　loop
end sub

お礼

ありがとうございました。
自分の作ったマクロでは流れると思うんですが、複数あってもなぜか途中で止まってしまってました。
このマクロを使わせてもらいました！

回答No.2

o_chi_chi

Set wb = Workbook.Open(fol & "\" & f)

　　　↓

Set wb = Workbooks.Open(fol & "\" & f)

お礼

ｓが足りなかったんですね、追加したら動くようになりました。
ありがとうございます。