|
Hallo! Dann einfach die Werte ändern. :-D Dafür hatte ich extra die Kommentare eingefügt, dass man sieht, was man ändern soll. Also 6 mal A + B und 2 mal C sieht dann so aus. Wie gesagt, einfach über die Durchläufe anpassen. Viele Grüße
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$1:$W$" & ende).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
.UsedRange.Columns(i + 7).Copy ActiveSheet.Cells(1, 5)
' Namen festlegen nach jew. Spalte
ActiveSheet.Name = ActiveSheet.Cells(1, 5)
If i > 4 Then ActiveSheet.Name = ActiveSheet.Name + "C"
Next i
'im Ausgang den Filter wieder rausnehmen
.Range("$A$1:$W$" & ende).AutoFilter
End With
Application.ScreenUpdating = True
End Sub
|