シート名のエラーを無視したい

Question

マクロ初心者です。
教えて下さい。

シートをコピーしようとすると「移動またはコピーしようとしている数式またはシートには、移動またはコピー先のワークシートに既にある名前’xxx’が含まれています。この名前を使用しますか？」というメッセージが表示される

[はい]をクリックし続行すると

実行時エラー1004

【Excel VBA】実行時エラー'1004': シートの名前をほかのシート、Visual Basicで参照されるオブジェクトライブラリまたはワークシートと同じ名前に変更することはできません。

デバッグでは
Sheets(cnt).name = Sheets("転記用リスト").Cells(i, 1).Value　がハイライトされる。

---

Sub く_転記用リストから請求書へ転記()

 Dim i As Long, cnt As Long

Dim name As Object

For Each name In Names
    If name.Visible = False Then
        name.Visible = True
    End If
Next



 Application.ScreenUpdating = False



 For i = 2 To Sheets("転記用リスト").Cells(Rows.Count, 1).End(xlUp).Row
     Sheets("ひな形").Copy After:=Sheets(Sheets.Count)
     cnt = Sheets.Count
     Sheets(cnt).name = Sheets("転記用リスト").Cells(i, 1).Value
     Sheets("転記用リスト").Cells(i, 1).Copy Sheets(cnt).Range("A12:G12")
     Sheets("転記用リスト").Cells(i, 2).Copy Sheets(cnt).Range("C28:I28")
     Sheets("転記用リスト").Cells(i, 6).Copy Sheets(cnt).Range("J28")
 Next


 Sheets("転記用リスト").Select



 Application.ScreenUpdating = True

End Sub

---

参照しているセルの転記は出来ていて、
ひな形をコピーしてセルA2の値でシート名・シートへの転記は出来ているが
最後に不要な"ひな形(2)"というコピーのセルが出来ています。

F8で1行ずつ実行すると、
cnt = Sheets.Count　のところで「移動またはコピーしようと…」のメッセージが出ていて、
[はい]をクリックし無視して続行すると
参照しているデータが無くなった後、最後に"ひな形(2)"のシートが出来、その後

実行時エラー'1004':
シートの名前をほかのシート、Visual Basicで参照されるオブジェクトライブラリまたはワークシートと同じ名前に変更することはできません。

デバッグすると
Sheets(cnt).name = Sheets("転記用リスト").Cells(i, 1).Value　がハイライトされています。

---

シート名の取得の為、以下のマクロを実行しました。

Sub てすと()
Dim Wsh As Worksheet
Dim i As Long
i = 1
For Each Wsh In Worksheets
With Worksheets("テスト")
.Cells(i, 1).Value = Wsh.name
i = i + 1
End With
Next
End Sub

---

結果は

layout
注意
Journal
Pay
Rcv
Company
Input
Output
Supplier Register
レート表
Example for manual
請求書sample
覚書
Journal (2)
ひな形
転記用リスト
(参照した1つ目)
(参照した2つ目)
(参照した3つ目)
ひな形(2)

です。

---

重複しているシート名は無いと思うのですが、　　
エラーを無視するという　　On Error Resume Next
というのを、先頭に入れてみました。

「移動またはコピーしようとしている数式またはシートには、移動またはコピー先のワークシートに既にある名前’xxx’が含まれています。この名前を使用しますか？」

のメッセージは出ましたが、実行時エラー1004は出ませんでした。

ですが、コピーして追加するシートが
(参照した1つ目)
(参照した2つ目)
(参照した3つ目)
ひな形(2)…ひな形(21)まで出来てしまいました。

どこをどう直して良いのかわかりません。
教えて頂けますか？

Answer 1

出来てしまった"ひな形(2)"…以降のシートを削除することで解決しました。

いろいろと勉強になりました。
ありがとうございました。

---

Sub ひな形2より右側のシートを削除する()
Dim LOOP_CNT As Long
Dim PAGE_CNT As Long

 On Error GoTo Err_RTN
 PAGE_CNT = Worksheets("ひな形 (2)").Index
 On Error GoTo 0
 Application.DisplayAlerts = False
 For LOOP_CNT = Worksheets.Count To PAGE_CNT Step -1
     Worksheets(LOOP_CNT).Delete
 Next
 Application.DisplayAlerts = True
 Exit Sub

Err_RTN:
MsgBox "ひな形(2)シートがありません"
End Sub

Answer 2

まず、エラーを無視してはいけません。

エラーを無視するという　　On Error Resume Next

上記は削除してください。

Sheets("ひな形").Copy After:=Sheets(Sheets.Count)

警告が出ている箇所は、上記になるかと思います。Sheetsの名前を明記せず、Sheets.Countで単に末尾に追加するだけにしていることが原因です。
その結果、"ひな形"というシートが二つでき、Excel側が自動で"ひな形 (2)"と重複を避けるべく連番を追加しています。

Sheets("ひな形").Copy After:=Sheets(Sheets("転記用リスト").Cells(i, 1).Value)

と名前を指定してあげるとエラーを回避できると思われます。

---

追記かつ訂正

Sheets("ひな形").Copy After:=Sheets(Sheets.Count)

私も誤解しておりました！

https://kosapi.com/post-2983/ によりますと、引数Afterは、既存シートの「後ろに」シートをコピーする、という意味だそうです。
ですので、既存のシートを指定しなければいけない。よって引数にSheets(Sheets.Count)を指定することは間違いではなかったです。大変失礼しました。

では、何がいけないか。

実行時エラー'1004':

シートの名前をほかのシート、Visual Basicで参照されるオブジェクトライブラリまたはワークシートと同じ名前に変更することはできません。

上記のエラーは、同じシート名のシートを二枚作ろうとした場合に発生します。
つまり、このマクロを2回実行すると、Sheets("転記用リスト").Cells(i, 1).Valueで参照する名前のシートが1回目に作成され、二回目実行時にはすでにその名前のシートがあるため、エラーとなります。

まずは、マクロで作る予定のシート名のシートが全くない状態に手動で戻してやるのが最も簡単かと思います。
つぎに、"転記用マクロ"シートのシート名が列挙しているセルに、同じ名前が2個存在していないかチェックしてください。
ある場合は一意になるよう名前を調整する。無い場合は、2回マクロを実行したことがエラーの原因となります。

マクロの方針ですが、「同じシート名が存在したら、古いシートを削除して、新たにコピーする」くらいの流れにするのが良いかと思います。
「同じ名前のシートの有無をチェックする」方法は、このへんのページが参考になるかと思います。

出張行ってらっしゃい。

Comments

[mln]

ありがとうございます。
エラーの無視は削除いたします。

シート名を自動で付与(A列に入っている値を参照)している為
名前を指定することが出来ないのですが
このような場合はどうすれば良いのでしょうか。

[kazto]

> Sheets(cnt).name = Sheets("転記用リスト").Cells(i, 1).Value

この行で名前を付けているんですね。見落としました。回答を修正します。

[mln]

ありがとうございます。

該当箇所修正して実行してみました。

----
Sub テスト_転記用リストから請求書へ転記()

Dim i As Long, cnt As Long

Dim name As Object

For Each name In Names
If name.Visible = False Then
name.Visible = True
End If
Next

Application.ScreenUpdating = False

For i = 2 To Sheets("転記用リスト").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("ひな形").Copy After:=Sheets(Sheets("転記用リスト").Cells(i, 1).Value)
cnt = Sheets.Count
Sheets(cnt).name = Sheets("転記用リスト").Cells(i, 1).Value
Sheets("転記用リスト").Cells(i, 1).Copy Sheets(cnt).Range("A12:G12")
Sheets("転記用リスト").Cells(i, 2).Copy Sheets(cnt).Range("C28:I28")
Sheets("転記用リスト").Cells(i, 6).Copy Sheets(cnt).Range("J28")
Next

Sheets("転記用リスト").Select

Application.ScreenUpdating = True

End Sub
----

今度は実行時エラー9：インデックスが有効範囲にありません。
で、該当箇所は教えて頂いた
Sheets("ひな形").Copy After:=Sheets(Sheets("転記用リスト").Cells(i, 1).Value)
がハイライトされます。

本当に何度も申し訳ありません。

[mln]

ありがとうございます。
これから出張となりますので、
また月曜日に確認させていただきます。

[mln]

ありがとうございます。
移動中でExcelが触れません。
明日も21:00-6:00までカンヅメになる為月曜日に確認させて頂きます！

[mln]

おはようございます。
転記用リスト内に、重複する名前はありませんでした。

「同じシート名が存在したら、古いシートを削除して、新たにコピーする」場合なのですがうまく組めません。

以下は重複を削除する場合ですが、これも行き詰っています。
----
Sub test()

'シート削除の確認ダイアログを出さないようにする
Application.DisplayAlerts = False

With ThisWorkbook
' Sheet2がない場合、Sheet2を追加
If SheetDetect("Sheet2") = False Then
.Worksheets.Add
.ActiveSheet.Name = "Sheet2"
End If

' Sheet1がある場合、Sheet1を削除
If SheetDetect("Sheet1") Then
.Worksheets("Sheet1").Delete
End If
End With

End Sub

----
だと、思うのですが
このシート名"Sheet1"や"Sheet2"を名前の指定をせずに"重複する場合"という風に組むにはどのような記述になるのでしょうか。