Hallo,

versuch mal:

Sub Schaltfläche1_Klicken()
Dim loLetzte As Long, loSpalte As Long, i As Long
Dim strBlattname As String

Application.ScreenUpdating = False

With ActiveSheet
    loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Row
    loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 2).Column
    .Range(.Cells(1, "A"), .Cells(loLetzte, "A")).Copy .Cells(1, loSpalte)
    .Columns(loSpalte).RemoveDuplicates Columns:=1, Header:=xlYes
    For i = 2 To .Cells(.Rows.Count, loSpalte).End(xlUp).Row
        strBlattname = .Cells(i, loSpalte)
        .Range("A1").CurrentRegion.AutoFilter field:=1, Criteria1:=.Cells(i, loSpalte)
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = strBlattname
        With .AutoFilter.Range
            .Copy
            Worksheets(strBlattname).Range("A1").PasteSpecial Paste:=xlPasteAll
        End With
    Next i
    .Columns(loSpalte).Delete
    .AutoFilterMode = False
    .Activate
End With
End Sub

Gruß Werner