尝试使用工作表名称错误处理错误

Question

问题 #2！

ThisWorkbook.Sheets("Project Template").Copy After:=Sheets(Sheets.Count)
Set ws = ActiveSheet

Naming = CallLaunched.Value & " - " & ProjectLead.Value

ws.Name = Naming

“命名”可能与之前生成的工作表相同，因此会引发错误。处理此问题的最佳方法是什么？

最好只使用 Error Goto 吗？如果是这样，句柄是否仅适用于命名行？

再次感谢任何帮助/解释。

提前致谢，

苏西

Answer 1

复制工作表（新名称问题）

• 确保Naming 包含有效的工作表名称。

Option Explicit

Sub CopyWorksheet()
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Source worksheet
    Dim sws As Worksheet: Set sws = wb.Worksheets("Project Template")
    
    ' Destination Worksheet Name
    Dim Naming As String: Naming = "Launched Project"
    'Naming = CallLaunched.Value & " - " & ProjectLead.Value
    
    ' Attempt to create a reference to the Destination Worksheet.
    On Error Resume Next
    Dim dws As Worksheet: Set dws = wb.Worksheets(Naming)
    On Error GoTo 0
    
    ' If it exists, delete it.
    If Not dws Is Nothing Then ' destination exists
        Application.DisplayAlerts = False ' delete without confirmation
        dws.Delete
        Application.DisplayAlerts = True
    Else ' destination doesn't exist
    End If
    
    ' Only now create a copy,...
    sws.Copy After:=wb.Sheets(wb.Sheets.Count)
    ' ... a reference,...
    Set dws = ActiveSheet
    ' and rename it.
    dws.Name = Naming
    
End Sub

Answer 2

手动复制工作表时，新名称会被编号以使其唯一，例如“Sheet1 (2)”。如果您想允许多次复制工作表，您可以执行类似操作 -

On Error Resume Next
ws.Name = Naming
If Err.Number Then
    n = 1
    Do
        Err.Clear
        n = n + 1
        ws.Name = Naming & "  (" & n & ")"
    Loop Until Err.Number = 0 ' Or n <= 50  ' limit how many times can copy?
End If
On error Goto 0

您可能需要更多处理以确保新名称长度不超过 31