Hey Mr. K.
der Code funktioniert leider nicht:
hier der komplette Code:
Sub Testfiler()
Dim arr(), lngRows As Long, selRng As Range, i As Long
Set selRng = Windows("Versandliste _MH_.xlsm").RangeSelection
ReDim arr(1000)
Workbooks("Laufende Aufträge.xlsm").Worksheets("Laufende Aufträge").Range("A1:Q1").AutoFilter Field:=5
lngRows = ActiveSheet.AutoFilter.Range.Rows.Count
For Each c1 In Range("E2:E" & lngRows)
For Each c2 In selRng
If c1 Like "*" & c2 & "*" Then
arr(i) = c1
i = i + 1
If i Mod 1000 = 0 Then ReDim Preserve arr(i + 1000)
End If
Next c2
Next c1
ReDim Preserve arr(i)
Workbooks("Laufende Aufträge.xlsm").Worksheets("Laufende Aufträge").Range("A1:Q1").AutoFilter Field:=5, Criteria1:=arr, Operator:=xlFilterValues
End Sub
Wo liegt der Fehler?
|