Option Explicit
Sub FilterVersion()
Dim x As Long
Dim c As Excel.Range
Dim rng As Excel.Range
Dim rngIsect As Excel.Range
Dim wks As Excel.Worksheet
Dim vSuchwerte() As Variant
Dim vSendungsnummern() As Variant
Set wks = ActiveSheet
vSuchwerte = Array("1650", "5940", "5950")
With wks
If .AutoFilterMode Then .AutoFilterMode = False
Set rng = .Range("A1:C" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
rng.AutoFilter Field:=2, Criteria1:=vSuchwerte, Operator:=xlFilterValues
Set rngIsect = Intersect(rng, rng.Offset(1), rng.SpecialCells(xlCellTypeVisible))
If Not rngIsect Is Nothing Then
ReDim vSendungsnummern(1 To rngIsect.Areas.Count)
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
rng.AutoFilter Field:=2
rng.AutoFilter Field:=1, Criteria1:=vSendungsnummern, Operator:=xlFilterValues
End Sub