问excel vba代码错误(下标超出范围)

EN

Option Explicit

Sub CopyActiveSheet()
    
    ' In the worst case scenario, you'll end up with an additional worksheet
    ' that could not be renamed. If you want to keep this worksheet,
    ' set DeleteIfCannotRename to False.
    Const DeleteIfCannotRename As Boolean = True
    
    ' Invalidate the active sheet.
    Dim sh As Object: Set sh = ActiveSheet
    If sh Is Nothing Then Exit Sub ' no visible workbooks open
    If Not TypeOf sh Is Worksheet Then Exit Sub ' not a worksheet
    
    ' Reference the source worksheet.
    Dim sws As Worksheet: Set sws = ActiveSheet
    
    ' Create a copy.
    sws.Copy After:=sws
    
    ' Reference the copy.
    Dim dws As Worksheet: Set dws = ActiveSheet
    
    ' Write the value form 'B3' to a variable.
    Dim dName As String: dName = CStr(dws.Range("B3").Value)
    
    Dim ErrNumber As Long
    
    ' Prevent error if a sheet with the same name already exists
    ' or the value in 'B3' doesn't contain a valid worksheet name.
    On Error Resume Next ' turn on error-trapping
        ' Attempt to rename.
        dws.Name = dName
        ErrNumber = Err.Number ' store the error number in a variable
    On Error GoTo 0 ' turn off error trapping
    
    ' Delete and inform. Out-comment or delete the 'MsgBox' line(s)
    ' if the message box is too annoying.
    If DeleteIfCannotRename Then ' will delete
        If ErrNumber <> 0 Then
            Application.DisplayAlerts = False
                dws.Delete
            Application.DisplayAlerts = True
            MsgBox "Could not rename to '" & dName & "' so it got deleted.", _
                vbCritical, "CopyActivesheet"
        End If
    Else ' will not delete
        MsgBox "Could not rename to '" & dName & "'.", _
            vbCritical, "CopyActivesheet"
    End If

End Sub