シートをコピーすると、コピー先のブックに同じ名前のシートが既に存在する場合、VBAはエラーを発生させます。
これを回避するには、シート名の重複を事前に確認し、ユニークな名前を付ける工夫が必要です。
1. シート名の重複をチェックする関数を作る
まず、指定したシート名が既に存在するかどうかを判定する関数を作成します。
'指定した名前のシートが存在するかを判定する関数
Function SheetExists(sheetName As String, wb As Workbook) As Boolean
Dim ws As Worksheet
SheetExists = False
For Each ws In wb.Sheets
If ws.Name = sheetName Then
SheetExists = True
Exit Function
End If
Next ws
End Function
2. 重複を回避してコピーするサンプルコード
以下のコードでは、コピー先のブックに同名シートがあれば、
**「シート名(2)」「シート名(3)」**という形で自動的に番号を付与します。
Sub CopySheetAvoidNameError()
Dim wb As Workbook
Dim newName As String
Dim baseName As String
Dim i As Long
'コピー先のブックを指定(例:Book2.xlsx)
Set wb = Workbooks("Book2.xlsx")
'元のシート名を取得
baseName = ActiveSheet.Name
newName = baseName
i = 1
'名前重複をチェックし、重複していたら連番を付加(上で作成した関数で確認)
Do While SheetExists(newName, wb)
i = i + 1
newName = baseName & "(" & i & ")"
Loop
'シートをコピー
ActiveSheet.Copy After:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Name = newName
End Sub
3. 簡易的な方法:エラー回避用の On Error を使う
シンプルにエラーを無視する方法もあります。
ただし、この方法では重複時に意図しないエラー処理が行われる可能性があるため、
**「エラー回避後に別名を付与する」**ようにして使うと良いでしょう。
Sub CopySheetWithOnError()
On Error Resume Next
ActiveSheet.Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "コピーシート"
If Err.Number <> 0 Then
'名前が重複した場合、別名に変更
Err.Clear
Sheets(Sheets.Count).Name = "コピーシート_" & Format(Now, "yyyymmdd_hhmmss")
End If
On Error GoTo 0
End Sub
4. まとめ
- シート名が重複すると
ActiveSheet.Copy
でエラーが発生する。 - 事前に名前の存在を確認し、連番を付けるのが安全な方法。
On Error
を使って、重複時に別名を付ける簡易的な回避策もある。
コメント