Moin! Also habe jetzt mal die Datei auf nem neuen System und mit der Originaldatei getestet. Musste nun feststellen, dass deine Auflistung als Tabelle formatiert ist. Da ging der Code nicht. Habe es jetzt mal angepasst und probiert. Läuft jetzt. Wie immer bitte mal testen. Falls du den Button zum Leeren noch mit aufnehmen willst, der Code stimmt jetzt auch. Schicke die Originaldatei heute Abend noch als link. Kann von hier aber nichts hochladen.  VG

Option Explicit
  
Dim stelle As Long
      
Sub filter_zurück()
Dim liste()
Dim daten()
Dim filterwerte()
ReDim liste(0)
Dim i As Long
Dim j As Long
Dim eintrag As Boolean
 
With ActiveSheet.ListObjects("Auftragsliste")

ReDim filterwerte(.AutoFilter.Range.Columns.Count)
'nur das erste Kriterium
For i = 2 To .AutoFilter.Range.Columns.Count
     If .AutoFilter.Filters(i).On Then
        filterwerte(i) = Right(.AutoFilter.Filters(i).Criteria1, Len(.AutoFilter.Filters(i).Criteria1) - 1)
     Else
        filterwerte(i) = ""
     End If
Next i
  
daten = Range(.AutoFilter.Range.Address)
  
stelle = stelle - 1
    
'Zeile 1 ist Übeschrift
    For i = 2 To .AutoFilter.Range.Rows.Count
        eintrag = True
        If UBound(Filter(liste, "x" & CStr(daten(i, 1)) & "x", , vbBinaryCompare)) = -1 Then
            For j = 2 To .AutoFilter.Range.Columns.Count
                If filterwerte(j) <> "" Then
                    If CStr(daten(i, j)) <> filterwerte(j) Then eintrag = False
                End If
            Next j
          
            If eintrag = True Then
                liste(0) = liste(0) + 1
                ReDim Preserve liste(liste(0))
                liste(liste(0)) = "x" & CStr(daten(i, 1)) & "x"
            End If
        End If
    Next
  
    If stelle = -1 Then stelle = UBound(liste)
    
    If stelle = 0 Then
        .Range.AutoFilter Field:=1
        Exit Sub
    End If
  
    .Range.AutoFilter Field:=1, Criteria1:=Replace(Replace(liste(stelle), "x", ""), ",", ".")

End With

End Sub
      
      
Sub filter_vor()
Dim liste()
Dim daten()
Dim filterwerte()
ReDim liste(0)
Dim i As Long
Dim j As Long
Dim eintrag As Boolean
  
With ActiveSheet.ListObjects("Auftragsliste")
  
ReDim filterwerte(.AutoFilter.Range.Columns.Count)
'nur das erste Kriterium
For i = 2 To .AutoFilter.Range.Columns.Count
     If .AutoFilter.Filters(i).On Then
        filterwerte(i) = Right(.AutoFilter.Filters(i).Criteria1, Len(.AutoFilter.Filters(i).Criteria1) - 1)
     Else
        filterwerte(i) = ""
     End If
Next i
  
daten = Range(.AutoFilter.Range.Address)
  
stelle = stelle + 1
 
    
'Zeile 1 ist Übeschrift
    For i = 2 To .AutoFilter.Range.Rows.Count
        eintrag = True
        If UBound(Filter(liste, "x" & CStr(daten(i, 1)) & "x", , vbBinaryCompare)) = -1 Then
            For j = 2 To .AutoFilter.Range.Columns.Count
                If filterwerte(j) <> "" Then
                    If CStr(daten(i, j)) <> filterwerte(j) Then eintrag = False
                End If
            Next j
          
            If eintrag = True Then
                liste(0) = liste(0) + 1
                ReDim Preserve liste(liste(0))
                liste(liste(0)) = "x" & CStr(daten(i, 1)) & "x"
            End If
        End If
    Next
      
    If stelle > UBound(liste) Then stelle = 0
  
    If stelle = 0 Then

        .Range.AutoFilter Field:=1
        Exit Sub
    End If
  
    .Range.AutoFilter Field:=1, Criteria1:=Replace(Replace(liste(stelle), "x", ""), ",", ".")

End With
End Sub
    
Sub erster()
Dim liste()
Dim daten()
Dim filterwerte()
ReDim liste(0)
Dim i As Long
Dim j As Long
Dim eintrag As Boolean
  
With ActiveSheet.ListObjects("Auftragsliste")
  
ReDim filterwerte(.AutoFilter.Range.Columns.Count)
'nur das erste Kriterium
For i = 2 To .AutoFilter.Range.Columns.Count
     If .AutoFilter.Filters(i).On Then
        filterwerte(i) = Right(.AutoFilter.Filters(i).Criteria1, Len(.AutoFilter.Filters(i).Criteria1) - 1)
     Else
        filterwerte(i) = ""
     End If
Next i
  
daten = Range(.AutoFilter.Range.Address)
  
 
    'Zeile 1 ist Übeschrift
    For i = 2 To .AutoFilter.Range.Rows.Count
        eintrag = True
        If UBound(Filter(liste, "x" & CStr(daten(i, 1)) & "x", , vbBinaryCompare)) = -1 Then
            For j = 2 To .AutoFilter.Range.Columns.Count
                If filterwerte(j) <> "" Then
                    If CStr(daten(i, j)) <> filterwerte(j) Then eintrag = False
                End If
            Next j
          
            If eintrag = True Then
                liste(0) = liste(0) + 1
                ReDim Preserve liste(liste(0))
                liste(liste(0)) = "x" & CStr(daten(i, 1)) & "x"
            End If
        End If
    Next
      
    If UBound(liste) > 0 Then
        stelle = 1
    Else
        Exit Sub
    End If
  
    .Range.AutoFilter Field:=1, Criteria1:=Replace(Replace(liste(stelle), "x", ""), ",", ".")

End With
End Sub
  
Sub alle_leeren()

Debug.Print ActiveSheet.ListObjects.Count

 ActiveSheet.ListObjects("Auftragsliste").AutoFilter.ShowAllData


stelle = 0
End Sub