|
Dann probiere es mal damit!
Sub blatt_nach_Filter_erzeugen()
Dim i As Integer
Dim ende As Long
Application.ScreenUpdating = False
'Blatt eins als Ausgang
With Worksheets(1)
ende = .Cells(Rows.Count, 23).End(xlUp).Row
' 6 für A/ B und 2 für C deshalv 8 Durchläufe kann man ändern, dann aber beim Filter darauf achten, wann C kommt
For i = 1 To 8
'Filter setzen
If i < 7 Then
'für die mit A und B
.Range("$A:$W").AutoFilter Field:=23, Criteria1:="=*A*", Operator:=xlOr, Criteria2:="=*B*"
Else
' die zwei für C ab Durchlauf 7
.Range("$A$1:$W$" & ende).AutoFilter Field:=23, Criteria1:="=*C*"
End If
' Blatt einfügen
Worksheets.Add After:=Sheets(Sheets.Count)
'A bis D kopieren - wird gefilter kopiert - kann man aber auch wandeln, dass die 4 Spalte ungefilter eingefügt werden und dann erst der Filter kommt
.UsedRange.Range("A:D").Copy ActiveSheet.Cells(1)
' jeztt noch die Spalte je nach Index einfügen
If i < 7 Then
.UsedRange.Columns(i + 7).Copy ActiveSheet.Cells(1, 5)
Else
' wiede rbei 7 und 8
.UsedRange.Columns(i + 5).Copy ActiveSheet.Cells(1, 5)
End If
' Namen festlegen nach jew. Spalte
If i > 6 Then
ActiveSheet.Name = ActiveSheet.Cells(1, 5) + "C"
Else
ActiveSheet.Name = ActiveSheet.Cells(1, 5)
End If
Next i
'im Ausgang den Filter wieder rausnehmen
.Range("$A$1:$W$" & ende).AutoFilter
End With
Application.ScreenUpdating = True
End Sub
|