Option Explicit

Sub FilterVersion()

    Dim x                   As Long             'Areas-Counter und ReDim für vSendungsnummern
    Dim c                   As Excel.Range      'For-Each-Zelle als Sammler der Sendungsnummern
    Dim rng                 As Excel.Range      'Filterbereich
    Dim rngIsect            As Excel.Range      'Schnittmenge gefilterter Bereich (Sendungsnummern); liefert Input für den Sammler
    Dim wks                 As Excel.Worksheet  'Intellisense
    Dim vSuchwerte()        As Variant          'Codes 1650, 5940, 5950
    Dim vSendungsnummern()  As Variant          '
    
    '*** Intellisense
    Set wks = ActiveSheet
    
    '*** Deine gesuchten Codes
    vSuchwerte = Array("1650", "5940", "5950")
    
    '*** Bereich ermitteln
    With wks
        If .AutoFilterMode Then .AutoFilterMode = False
        Set rng = .Range("A1:C" & .Cells(.Rows.Count, 1).End(xlUp).Row)                 '<~~ Bereich anpassen
    End With
    
    '*** Filtern und Schnittmenge als Range-Objekt
    rng.AutoFilter Field:=2, Criteria1:=vSuchwerte, Operator:=xlFilterValues            'Filtern anhand der Codes
    Set rngIsect = Intersect(rng, rng.Offset(1), rng.SpecialCells(xlCellTypeVisible))   'Range-Objekt bilden um Sendungsnummern einzusammeln
    
    '*** Sendungsnummern ermitteln
    If Not rngIsect Is Nothing Then
        ReDim vSendungsnummern(1 To rngIsect.Areas.Count)                               'Anzahl Sendungsnummern; mit Doppler(!)
        For x = 1 To rngIsect.Areas.Count
            For Each c In rngIsect.Areas(x).Columns(1)
                vSendungsnummern(x) = c.Value
            Next
        Next x
    End If
    
    '*** Anhand Sendungsnummern YES/NO
    rng.AutoFilter Field:=2
    rng.AutoFilter Field:=1, Criteria1:=vSendungsnummern, Operator:=xlFilterValues
End Sub

Der oben gezeigte Code orientiert sich an folgender Tabelle: