excel - 如果出现错误 'Next' 结束 VBA，则会出现 'On Error' 问题

Question

我有一个代码来过滤数据并复制到新工作表。我有一个问题，如果正在创建的工作表已经存在，那么它将跳转到错误处理并停止不继续剩余的“下一个”。如果我在错误处理后移动“下一步”，它只会在有错误时循环。有没有办法让我两者兼得？

Sub SortDataAll()
    ' Sort Data All

    If (Workbooks("Fakturagrunnlag All_1.xlsm").Sheets("All Focal Point Data").AutoFilterMode And Workbooks("Fakturagrunnlag All_1.xlsm").Sheets("All Focal Point Data").FilterMode) _
      Or Workbooks("Fakturagrunnlag All_1.xlsm").Sheets("All Focal Point Data").FilterMode Then
        Workbooks("Fakturagrunnlag All_1.xlsm").Sheets("All Focal Point Data").ShowAllData
    End If

    '~~> Set filter of main data
    Dim rRange As Range
    Dim rCell As Range
    Set rRange = Worksheets("Front Page").Range("A7:A21")

    For Each rCell In rRange
        MsgBox "Setting filter for " & rCell

        Dim rList As String
        rList = rCell & "List"

        MsgBox "The list for filter is" & rList

        ' can remove after
        Worksheets("All Focal Point Data").Activate

        Dim v As Variant
        v = Application.WorksheetFunction.Transpose(Range(rList).Value)

        Range("A:BC").AutoFilter Field:=54, Criteria1:=v, Operator:=xlFilterValues
        Selection.AutoFilter Field:=54, Criteria1:=v, Operator:=xlFilterValues

        MsgBox "Check data is filtered"

        '~~> Create new sheet and paste data
        On Error Resume Next

        With ThisWorkbook
            .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = rCell
        End With

        If Err Then GoTo ErrorJump

        Err.clear

        Worksheets("All Focal Point Data").Range("A1:BC5000").Copy Worksheets(rCell).Range("A1").Paste
        Columns("BB:BB").Delete Shift:=xlToLeft

    Next rCell

    Exit Sub

ErrorJump:
    MsgBox "Sheet already exists":
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    'Worksheets("Front Page").Activate
    'Range("A1").Select

    Next rCell
End Sub

Answer 1

我使用了一种方法，您只需尝试使用工作表并在引发错误时让错误控制创建工作表。

在此，如果存在 abc 工作表，则使用它。如果它不存在，则创建然后使用它。

sub testws()

    dim wsn as string

    wsn = "abc"

    on error goto make_ws
    with worksheets(wsn)
        on error goto 0
        ...
    end with

    exit sub

make_ws:
    with worksheets.add
        .name = wsn
    end with
    resume

end sub