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