全てのブックへのシートの挿入

質問

同じフォルダーにある全てのブックに同じシートを３枚先頭から挿入したいのですが、どうすればよろしいでしょうか？ご教示お願い致します。

回答No.9

toshi_2000

それでは、エラーになっている分をすこしずつ短くしていきましょうか。
まずは、シートが３つあるのを２つにしてどうなるか。
だめならシートを１つにしてみてどうなるか。
ひとつずつ試してみるしかないですね。

お礼

色々とお教えいただいたにも関わらず、何故かうまく行きません。ご丁寧な解説を裏切るようで申し訳なく思っています。もう少し勉強した後で再度お聞きします。

ありがとうございました。

補足

お付き合いいただいてまことにありがとうございます。一つずつ試してみます。

回答No.8

toshi_2000

なぜできないのでしょうね。
シート名を半角文字にして試してもらえませんか。
よろしくおねがいします。

補足

やはりだめでした・・・　同じエラーが出てしまいます。せっかく親切に教えていただいているのに申し訳ありません。

回答No.7

toshi_2000

No.６の訂正です。
「大文字」ではなく「全角文字」であることを確認願います。

補足

ご返答が遅れて申し訳ありません。全角文字で合っています。

回答No.6

toshi_2000

"Ｚ１", "Ｚ２", "Ｚ３"の英数字が全て大文字ですが、シート名とマクロで合っていますか。
申し訳ないですが、もう一度、ご確認ください。

回答No.5

toshi_2000

追加したい３枚のシートが既にあるファイルとこれから追加したいファイルが同じフォルダにありますか。
そうでしたら、違うフォルダにして試してください。

補足

やはりだめでした。違うフォルダに入れると”インデックスが有効範囲にありません”エラーが出ます。元のブックにもコピーされていません。下の←部分がデバッグで黄色になった部分です。

Sub シートの挿入()

mybook = ActiveWorkbook.Name
dir名 = "C:\ＸＸＸ\"
book名 = Dir(dir名 & "ＹＹＹ.xls")
Workbooks(mybook).Activate
Sheets(Array("Ｚ１", "Ｚ２", "Ｚ３")).Copy←この部分が黄色になる
Before:=Workbooks(book名).Sheets(1)
ActiveWorkbook.Save
ActiveWorkbook.Close

Do While True
book名 = Dir
If book名 = "" Then Exit Do
Workbooks.Open dir名 & book名
Workbooks(mybook).Activate
Sheets(Array("Ｚ１", "Ｚ２", "Ｚ３")).Copy Before:=Workbooks(book名).Sheets(1)
ActiveWorkbook.Save
ActiveWorkbook.Close
Loop

End Sub

回答No.4

toshi_2000

Sheets(Array("1", "2", "3")).Copy Before:=Workbooks(book名).Sheets(1)
このエラーが発生するのは、Arrayの後ろのシート名が違うか、最後のシート番号が違うかのどちらかです。
一度ご確認下さい。

補足

シート名を変えたところ、挿入したい３枚のシートがあるブックにその３枚のシートがコピーされてしまいました。さらに、そのブックがＣｌｏｓｅしてしまって終わります。

Sub シートの挿入()

mybook = ActiveWorkbook.Name
dir名 = "C:\ＸＸＸ\"
book名 = Dir(dir名 & "ＹＹＹ.xls")
Workbooks(mybook).Activate
Sheets(Array("Ｚ１", "Ｚ２", "Ｚ３")).Copy Before:=Workbooks(book名).Sheets(1)
ActiveWorkbook.Save
ActiveWorkbook.Close

Do While True
book名 = Dir
If book名 = "" Then Exit Do
Workbooks.Open dir名 & book名
Workbooks(mybook).Activate
Sheets(Array("Ｚ１", "Ｚ２", "Ｚ３")).Copy Before:=Workbooks(book名).Sheets(1)
ActiveWorkbook.Save
ActiveWorkbook.Close
Loop

End Sub

回答No.3

toshi_2000

エラー発生時にデバッグを押すと、エラーが発生した行が表示されます。
その行を教えてください。

補足

Sheets(Array("1", "2", "3")).Copy Before:=Workbooks(book名).Sheets(1)

↑ここの部分です。ちなみに、挿入したい３つのシートがあるブックを開いている状態からマクロを実行させるため、Workbooks(mybook).Open は削除しました。

回答No.2

toshi_2000

ディレクトリ名とシート名（２箇所）を変更すればＯＫです、
mybook = ActiveWorkbook.Name
dir名 = "c:\test\"
book名 = Dir(dir名 & "*.xls")
Workbooks.Open dir名 & book名
Workbooks(mybook).Activate
Sheets(Array("1", "2", "3")).Copy Before:=Workbooks(book名).Sheets(1)
ActiveWorkbook.Save
ActiveWorkbook.Close

Do While True
book名 = Dir
If book名 = "" Then Exit Do
Workbooks.Open dir名 & book名
Workbooks(mybook).Activate
Sheets(Array("1", "2", "3")).Copy Before:=Workbooks(book名).Sheets(1)
ActiveWorkbook.Save
ActiveWorkbook.Close
Loop

補足

ご丁寧にありがとうございました。早速試してみましたが、”インデックスが有効範囲にありません”と出てしまいます。マクロはあまり詳しくないのですが、問題点をお教え頂ければ幸いです。よろしくお願い致します。

回答No.1

toshi_2000

マクロを使うしかなさそうです。

補足

マクロの場合だとどのように書けばよろしいでしょうか？