Hallo Till,

dein Code funktioniert wunderbar. Leider kopiert er alles unformatiert. Und ich habe den Fehler gemacht, dass ich meine Sheetnames nicht als String definiert habe, obwohl ich es so brauche. Deshalb konnte ich nur Teile deines Codes auf meine Bedürfnisse anpassen. Mein Fehler.

Ich habe weiter an dem Code gebastelt und ihn zum Laufen gebracht. Er ist zwar nicht so schön programmiert und sehr lang, aber für mich ist entscheidend, dass er funzt. An der Stelle nochmal ein Dank an Till für die Hilfe. Ich bin etwas anders an die Sache herangegangen. Ich lasse die Autofilter in dem shTMD setzten und kopiere das Sheet. Dies wiederhole ich 6 mal, und lass den Autofilter vom shTDM am Ende rausnehmen.

Für die die es interessiert, der unschöne Code der funzt:

Sub AFilter3()

Application.ScreenUpdating = False
Dim SheetName As String
Dim rng As Range, shTMD As Object

     
    Set shTMD = Sheets("Total (Monthly Development)")
   
    'Hier wird der Autfilter gesetzt
        With shTMD
            LastRow = .Range("C3000").End(xlUp).Row 'letzte Zelle in Spalte C über Zeile 3000
            .AutoFilterMode = False
            Set rng = .Range(.Cells(3, 1), .Cells(LastRow, 8)) 'gefilterter Bereich
           
        End With
            rng.Autofilter
        With shTMD
            Set rng = .Range(.Cells(3, 1), .Cells(LastRow, 8))
           
            rng.Autofilter Field:=6, Criteria1:="London"
            rng.Autofilter Field:=8, Criteria1:="Actual"
            SheetName = "London"
            .Copy After:=Sheets("Total (Monthly Development)")
            ActiveSheet.Name = "London"
            .AutoFilterMode = False
           
            rng.Autofilter Field:=6, Criteria1:="Belfast"
            rng.Autofilter Field:=8, Criteria1:="Actual"
            SheetName = "Belfast"
            .Copy After:=Sheets("Total (Monthly Development)")
            ActiveSheet.Name = "Belfast"
            .AutoFilterMode = False
           
            rng.Autofilter Field:=6, Criteria1:="Liverpool"
            rng.Autofilter Field:=8, Criteria1:="Actual"
            SheetName = "Liverpool"
            .Copy After:=Sheets("Total (Monthly Development)")
            ActiveSheet.Name = "Liverpool"
            .AutoFilterMode = False
        

    End With
   
    Sheets("Total (Monthly Development)").Activate
       
Application.ScreenUpdating = True

Habe nur drei Locations hinzugefügt, um den Post nicht lang zu halten.