AW: Tabellenblatt aufteilen auf x Blätter
12.07.2008 15:53:52
Daniel
Hi
du könntest dieses Makro verwenden:
Sub Aufteilen()
Dim Zelle1 As Range
Dim Zelle2 As Range
With Sheets("Kunden")
Set Zelle2 = .Range("B1") 'Berater stehen in Spalte B
.Range("A1").CurrentRegion.Sort key1:=Zelle2, order1:=xlAscending, header:=xlYes
Do
Set Zelle1 = Zelle2.Offset(1, 0)
If Zelle1.Value = "" Then Exit Do
Set Zelle2 = Zelle2.EntireColumn.Find(what:=Zelle1.Value, _
after:=.Cells(Rows.Count, Zelle2.Column), _
lookat:=xlWhole, searchdirection:=xlPrevious)
Sheets.Add after:=Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Zelle1.Value
.Rows(1).Copy Destination:=Cells(1, 1)
.Range(Zelle1, Zelle2).EntireRow.Copy Destination:=Cells(Rows.Count, 1).End(xlUp). _
Offset(1, 0)
Loop
End With
End Sub
sollte das Makro ein zweites mal laufen, musst du vorher die Beraterblätter wieder löschen.
Gruß, Daniel
hier die Datei dazu:
https://www.herber.de/bbs/user/53770.xls