【VBA】コピー時の名前重複エラーを回避する工夫

シートをコピーすると、コピー先のブックに同じ名前のシートが既に存在する場合、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 を使って、重複時に別名を付ける簡易的な回避策もある。

コメント

タイトルとURLをコピーしました