こんにちは、Ryoです。
用途によってはExcelのSheetを複数、又は大量にコピーすることがあると思いますが、この時にブックに定義名が付いていると「1004」エラーが発生することがあります。今回はそのエラー発生の確認と対処、参考としてワークシート末尾へのコピーについて書いていきます。
1.シートコピーのエラーについて
Excel2010を使用していた頃にも発生していたエラーなのですが、Excel2016の現在でも同様の現象が発生するようです。発生する要因は「ブックに定義名（セルへの名前設定など）」が付いていて、ブックを保存や閉じることをしないまま複数～大量のシートを連続コピーすると発生します。
この内容は以前にMicrosoftサポートに記載されていましたが2021.1月時点では削除されてしまっているようです。私の環境で確認した結果、コピー数210枚目で「1004」エラーになりました。
因みに「ブックの定義名を付けない状態」であれば、保存も閉じもしない状態であっても1000枚連続コピーが正常終了していましたので、定義に関連するエラーのようですね。
2.シートコピーエラーの回避
上述のMicrosoftサポートに記載されている通り、一定のタイミングで「保存・閉じる」操作を行えば回避できますのでサンプルコードとしては以下のようになります。
Sub Sample1()
Dim SampleBook As Workbook
Dim Addr As String
Dim i As Long
'ブックの追加
Set SampleBook = Application.Workbooks.Add
'セルに名前を付ける
SampleBook.Names.Add Name:="tempRange", _
RefersTo:="=Sheet1!$A$1"
'実行ファイルと同Pathに「Sample.xlsx」として名前設定
Addr = ThisWorkbook.Path & "\Sample1.xlsx"
'ブックを保存する
SampleBook.SaveAs Addr
'処理数を300回（シートを300枚追加）
For i = 1 To 300
'Sheetコピー実行
SampleBook.Worksheets(1).Copy _
after:=SampleBook.Worksheets(1)
'Mod演算子にて剰余判定を行い、シート100枚追加毎に処理実行
If i Mod 100 = 0 Then
'ブックを上書き保存⇒閉じる
SampleBook.Close SaveChanges:=True
Set SampleBook = Nothing
'再度「Sample1.xlsx」を開く
Set SampleBook = Application.Workbooks.Open(Addr)
End If
Next
End Sub
このコードを実行すると「Sample1.xlsx」ブックが生成され、そのSheet1をコピーし同ブックに300枚追加していきます。その際にエラーを回避する為、100枚コピーする毎に剰余判定し「ブック上書き保存」⇒「閉じる」⇒「開く」処理を行っています。
各SheetもセルA1には名前設定
コピー追加は300枚なので最終SheetがSheet1(301)になります。
本コードでは1004エラーの発生を確認出来ませんので対処できるものと思います。ですが、「保存/閉じる/開く」タイミングを連続コピー数300に対し40回毎に変えてみたところ、同様に「1004エラー」が発生しましたので保存処理などの実行頻度にも注意が必要です。
また、私の経験上ではブックに定義名が付いていて、保存未実行の状態でSheetを連続コピーしようとすると数枚から数十枚程度でもエラーになることがありました。この時はコピー処理開始前に保存を実行することで回避できましたので参考までに。
3.【参考】シートへのコピーについて
シートのコピーに関連して私も忘れがちで？？となるのが、シートコピー先の位置なので備忘録としてもまとめておこうと思います。
◆Sample1コードでのSheetの並び
上述のSample1では画像の通りSheet1の隣がSheet1(301)となっていますが、この挙動は以下の通りです。
WorkSheets(1)とは指定したブックのSheet左端を指すので、その後ろに順次追加されていきますから、このような形になります。この指定では実運用上使い難いですね。
◆Sheetの並びを逆順（before)にする
次にSample1の記述内で「after」を「before」に変更するとどうなるか確認してみますと、以下のようになります。
Sub Sample2()
Dim SampleBook As Workbook
Dim Addr As String
Dim i As Long
Set SampleBook = Application.Workbooks.Add
SampleBook.Names.Add Name:="tempRange", _
RefersTo:="=Sheet1!$A$1"
Addr = ThisWorkbook.Path & "\Sample1.xlsx"
SampleBook.SaveAs Addr
For i = 1 To 300
SampleBook.Worksheets(1).Copy _
before:=SampleBook.Worksheets(1)
'Sample1()に対し、before指定に変更
If i Mod 100 = 0 Then
SampleBook.Close SaveChanges:=True
Set SampleBook = Nothing
Set SampleBook = Application.Workbooks.Open(Addr)
End If
Next
End Sub
この場合の挙動は以下のようになります。
WorkSheets(1)＝左端なので、その前に順次追加されていきますので新規追加分が左端に追加されます。これは用途によっては有用です。
◆Sheetの末尾にコピーする
やはり時系列的にすっきり右から左へコピーしたいケースが多いですよね。この場合はWorkSheets(1)をWorksheets(Worksheets.Count)とすればOKです。
Sub Sample3()
Dim SampleBook As Workbook
Dim Addr As String
Dim i As Long
Set SampleBook = Application.Workbooks.Add
SampleBook.Names.Add Name:="tempRange", _
RefersTo:="=Sheet1!$A$1"
Addr = ThisWorkbook.Path & "\Sample1.xlsx"
SampleBook.SaveAs Addr
For i = 1 To 300
SampleBook.Worksheets(1).Copy _
after:=SampleBook.Worksheets(Worksheets.Count)
'Sample1()に対し、Worksheets.Count指定に変更
If i Mod 100 = 0 Then
SampleBook.Close SaveChanges:=True
Set SampleBook = Nothing
Set SampleBook = Application.Workbooks.Open(Addr)
End If
Next
End Sub
Worksheets.Countとすることで、コピーしたシートを追加する時点での総シート数をカウントしますので、そこにafter（後ろ）指定することで末尾に追加していくことが出来ます。
本コードを実行すると以下の並びで連続コピーされます。
4.まとめ
ブックの定義名がなければエラーは発生しにくいようですが、不要なエラーを回避する上でも対処について知っておいた方が無難かと思います。
私の場合は収集したデータを指定フォームに書き換える際に、様式原紙をコピーして末尾に追加していく形が多いので今回の記事内容は比較的利用頻度が高いです。もし今後同様のケースがあれば、対処の参考にしていただければと思います。
以上、シート連続コピーのエラー回避／末尾へコピーする方法についてでした！今回の記事が何かの参考になれば幸いです。
Ryo
