Hi Gast3204,

hier mal mein Code:

Sub FilterAUFTRAGSNR__TEST()

Dim arr As Variant
Dim rng As Range, va As Variant
Dim i As Long, j As Long, k As Long

Set rng = Selection.SpecialCells(xlCellTypeConstants)
ReDim arr(1 To rng.Count)

k = 1
For i = 1 To rng.Areas.Count
    For j = 1 To rng.Areas(i).Cells.Count
        If rng.Areas(i).Cells(j).Value <> "" Then
            arr(k) = rng.Areas(i).Cells(j).Text
            k = k + 1
        End If
    Next j
Next i

If UBound(arr) = 1 Then
    Dim s As String
    va = xlAnd: s = arr(1)
    Workbooks("Laufende Aufträge.xlsm").Worksheets("Laufende Aufträge").Range("A1:Q1").AutoFilter _
        Field:=5, Criteria1:="*" & s & "*", Operator:=va
        
ElseIf UBound(arr) = 2 Then
    va = xlOr
    Workbooks("Laufende Aufträge.xlsm").Worksheets("Laufende Aufträge").Range("A1:Q1").AutoFilter _
        Field:=5, Criteria1:="*" & arr(1) & "*", Operator:=va, Criteria2:="*" & arr(2) & "*"
        

ElseIf UBound(arr) > 2 Then
    va = xlFilterValues
    Workbooks("Laufende Aufträge.xlsm").Worksheets("Laufende Aufträge").Range("A1:Q1").AutoFilter _
        Field:=5, Criteria1:=arr, Operator:=va

End If
End Sub

Anforderung:
in dem rot markierten Bereich fehlen die "*". Ähnlich wie bei "ElseIf UBound(arr) = 2 Then".
Bekomme die "*" aber nicht einfach so da rein...

Danke für deine Hilfe....