エクセルマクロがエラーになります。

質問

マクロの達人の皆様；
複数のブックをzenkokuというブックにまとめる必要があるのですが
下記の＊のところで「オブジェクト不足」のエラーになってしまいます。本を読んでもファイル間のやりとりのサンプルが無く困っております。
まとめ方は各地域の先頭シートを全国のシートにどんどん追加する形でこんなコードです。
----------------------------------
Sub bookipponka()
Workbooks.Open Filename:="C:\全国.xls"
Dim nm As Variant
nm = ActiveWorkbook.Name
Debug.Print nm
Workbooks.Open Filename:="C:\東京.xls"
Dim nm1 As Variant
nm1 = ActiveWorkbook.Name
＊nm1.Worksheets(1).Copy Before:= _
nm.Worksheets(1)
　以下　地域ファイルのＯＰＥＮ、全国へ貼り付けの繰り返し
------------------------------------
苦労の結果、奇跡的に動いたのですが、勘違いでファイルの保存もれをしてしまいました。
過程を記録していなかったので、どこをどう直したら動いたのか
再現出来ません。「Application.」が足りないような気がしてるのですが。ご指摘お願いします。
ついでといってはなんですが・・・
今回はファイル名を直指定してますが、「あるフォルダの全部のエクセル」という形でループさせることが出来れば非常にありがたいです。
よろしくお願いします。

回答No.2

zap35 · ベストアンサー

＞nm1.Worksheets(1).Copy
Workbooks(nm1).Worksheets(1).Copy
なら分かりますが、質問の書き方ではエラーになります

以下のマクロは閉じているBookはOpenしてシート1をコピー、開いているシートはそのままシート1をコピーするものです。

Sub bookipponka()
Dim wb, Zenkoku As Workbook
Dim buf As String
Dim psw As Boolean
Const fl As String = "C:\全国.xls"　←ここにフルパスで指定
　Application.ScreenUpdating = False
　On Error GoTo end0
　Workbooks.Open Filename:=fl
　Set Zenkoku = ActiveWorkbook
　buf = Dir(Zenkoku.Path & "\*.xls")
　Do While buf <> ""
　　If buf <> Zenkoku.Name Then
　　　psw = False
　　　For Each wb In Workbooks　'Bookが開いているか検査
　　　　If wb.Name = buf Then
　　　　　psw = True
　　　　　Exit For
　　　　End If
　　　Next wb

　　　If psw Then　'シートが既に開いているとき
　　　　Workbooks(buf).Worksheets(1).Copy _
　　　　　　before:=Zenkoku.Worksheets(1)
　　　Else　'シートが開いていないとき
　　　　Workbooks.Open Filename:=buf
　　　　Workbooks(buf).Worksheets(1).Copy _
　　　　　　before:=Zenkoku.Worksheets(1)
　　　　Workbooks(buf).Close savechanges:=False
　　　End If
　　End If
　　buf = Dir()
　Loop
end0:
　Application.ScreenUpdating = True
End Sub

お礼

回答ありがとうございます。
>Workbooks(nm1).Worksheets(1).Copy
明日試してみます。

>下のマクロは閉じているBookはOpenしてシート1をコピー、開いているシートはそのままシート1をコピーするものです。
ピンポン！です。
実は元のエクセルを直して、ファイルを開きっぱなしだと
警告が出てマクロを終了せざるを得なかったりと作業上
困っていたところです。「if psw]ですか・・勉強になります。

大量のため手作業では嫌になるような処理がマクロで一気に
動く様を見ていると、気持ちがいいですね。

ありがとうございました。前回も回答頂きましたが
又懲りずに恥ずかしい質問をすると思いますので今後もよろしく
お願いします。

回答No.1

papayuka

パッと見た感じでは動いた事すら疑問に思いますので、何処を修正すべきかは答えられません。

フォルダ内のループは何通りか書き方がありますが、
下記のマクロを記述したブックを適当なフォルダに保存します。
実行すると、同じフォルダ内のExcelファイルを次々開いて、1枚目のシートをこのブックにコピーして行きます。
参考まで。

Sub Test()
Dim myDir As String, myName As String, wb As Workbook
myDir = ThisWorkbook.Path & "\"
myName = Dir(myDir & "*.xls", vbNormal)
Do While myName <> ""
　 If myName <> ThisWorkbook.Name Then
　　　Set wb = Workbooks.Open(myDir & myName)
　　　wb.Worksheets(1).Copy after:= _
　　　ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
　　　wb.Close
　 End If
　 myName = Dir
Loop
End Sub

お礼

>パッと見た感じでは動いた事すら疑問に思いますので//
ごもっともです。見ようみまねでマクロをかじった
状態ですので笑ってやってください。
「あるブックのシートをコピーして、あるブックのシートにはりつける」という
中身は簡単なことですが構文？のエラーでひっかかりました。
でも昼間は勘でいじくりながらエラーをつぶしていったら
本当に動いたのですよ。
（ただし理論の裏づけが無いので、再現できません。）
頂いたコードはありがたく頂戴します。
これで明日の仕事がはかどります。
回答ありがとうございました。