Formular muligvis?

Sub Test()

homeMap = ActiveWorkbook.Name
homeArk = ActiveSheet.Name
home = ActiveCell.Address

On Error GoTo Fejl

        Dim svar1 As String
        Dim svar2 As String
        Dim CorrectAnswer As Boolean
            Do
        svar1 = InputBox("Første sortering." & vbCrLf & vbCrLf & _
        "Indtast kolonne Nr.", "Flyt til nyt ark")
            If svar1 = vbchancel Then GoTo Slut
            If IsNumeric(svar1) Then
                CorrectAnswer = True
               
                Else
                CorrectAnswer = False
                MsgBox "Det var skidt - men vi prøver bare igen!" & vbCrLf & _
                "Du skal skrive kolonne som et tal."
            End If
                Loop Until CorrectAnswer
        svar2 = InputBox("Første sortering." & vbCrLf & vbCrLf & _
        "Indtast søge ord?", "Flyt til nyt ark")
        If svar2 = vbchancel Then GoTo Slut
         
ActiveSheet.Range("$A$1").AutoFilter Field:=svar1, Criteria1:="=" & svar2

        Dim svar3 As String
        Dim svar4 As String
            Do
        svar3 = InputBox("Anden sortering." & vbCrLf & vbCrLf & _
        "Indtast kolonne Nr.", "Flyt til nyt ark")
        If svar3 = vbchancel Then GoTo Slut
            If svar3 = vbchancel Then GoTo Slut
            If IsNumeric(svar3) Then
                CorrectAnswer = True
               
                Else
                CorrectAnswer = False
                MsgBox "Det var skidt - men vi prøver bare igen!" & vbCrLf & _
                "Du skal skrive kolonne som et tal."
            End If
                Loop Until CorrectAnswer
        svar4 = InputBox("Anden sortering." & vbCrLf & vbCrLf & _
        "Indtast søge ord?", "Flyt til nyt ark")
        If svar4 = vbchancel Then GoTo Slut
       
ActiveSheet.Range("$A$1").AutoFilter Field:=svar3, Criteria1:="=" & svar4

Application.ScreenUpdating = False
     
    Sidste = Cells(Rows.Count, 9).End(xlUp).Row
    If Sidste = 1 Then GoTo Ingen

            Rows("1:" & Sidste).Copy
            Sheets.Add After:=Sheets(Sheets.Count) 'Ny fane
            'Workbooks.Add  'Ny Mappe
            ActiveSheet.Paste
            ActiveSheet.Range("A1").Select
      GoTo Slut
     
Ingen:
MsgBox "Ingen poster fundet"
GoTo Slut

Fejl:
MsgBox "Der opstod en fejl !!!"

Slut:
Workbooks(homeMap).Activate
Sheets(homeArk).Select
Range(home).Select

Application.CutCopyMode = False

AutoFilterMode = False

Application.ScreenUpdating = True

End Sub