|  
                                             
	Also dann folgt jetzt unten der Code. Der Durchläuft 8 mal eine Schleife. Je nach Durchlaufindex wird ein andere Filter gesetzt und eine andere Spalte kopiert. 
	Mal schnell im Durchlauf: 
	1. Durchlauf i = 1 
	Spalte A bis M Filter A oder B in M gesetzt 
	neues Blatt 
	A bis D kopiert 
	Spalte 7 (= G) kopiert 
	Name aus der eingefügten Spalte 
	 
	2. Durchlauf i = 2 
	Spalte A bis M Filter, A oder B in M gesetzt 
	neues Blatt 
	A bis D kopiert 
	Spalte 8 (= H) kopiert 
	Name aus der eingefügten Spalte 
	 
	und so weiter bis 6, wobei hier bis Spalte L kopiert wird - wird geregelt über .UsedRange.Columns(i + 6).Copy ActiveSheet.Cells(1, 5), beachte dabei Wert von i 
	 
	7. Durchlauf i = 7 
	Spalte A bis M Filter C in M gesetzt 
	neues Blatt 
	A bis D kopiert 
	Spalte 11 (= K) kopiert  - das wid hierüber geregelt .UsedRange.Columns(i + 4), beachte Wert von i 
	Name aus der eingefügten Spalte + C 
	 
	8. Durchlauf i = 1 
	Spalte A bis M Filter C in M gesetzt 
	neues Blatt 
	A bis D kopiert 
	Spalte 12 (= L) kopiert 
	Name aus der eingefügten Spalte + C 
	Ende der Durchläufe 
	 
	Das sollte so sein, wie du es wolltest, Geh das oben (die Durchläufe) bitte mal durch und schau, was anders werden soll. 
	Hier nun der Code. 
	  
Sub blatt_nach_Filter_erzeugen()
 
Dim i As Integer
 
Application.ScreenUpdating = False
 
'Blatt eins als Ausgang
With Worksheets(1)
' 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:$M").AutoFilter Field:=13, Criteria1:="=*A*", Operator:=xlOr, Criteria2:="=*B*"
    Else
    ' die zwei für C ab Durchlauf 7
        .Range("$A:$M").AutoFilter Field:=13, 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 + 6).Copy ActiveSheet.Cells(1, 5)
    Else
    ' wiede rbei 7 und 8
    .UsedRange.Columns(i + 4).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:$M").AutoFilter
 
End With
 
Application.ScreenUpdating = True
 
End Sub
	  
     |