Ошибка с «Next», если есть ошибка «On Error», завершает VBA

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