複数ブックへ一括コピー

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 回答日時： 2012/06/29 16:11

こんなカンジ。

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

この回答へのお礼

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

お礼日時：2012/06/29 18:22

No.2 回答者： o_chi_chi 回答日時： 2012/06/29 16:14

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

　　　↓

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

この回答へのお礼

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

お礼日時：2012/06/29 18:23