AW: Je Zelleintrag separates Tabellenblatt
11.07.2011 18:33:31
Reinhard
Hallo Kai,
zugegeben, nicht groß getestet, eher gar nicht, aber probier mal bitte das und berichte:
Sub Test()
Dim Zei As Long, colC As New Collection, C As Long, ZeiC As Long
On Error Resume Next
With Worksheets("Tabelle1")
For Zei = 1 To .Cells(Rows.Count, 3).End(xlUp).Row
colC.Add Item:=.Cells(Zei, 3).Value, key:=.Cells(Zei, 3).Value
Next Zei
For C = 1 To colC.Count
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = colC(C)
.Rows(1).Copy Destination:=Worksheets(colC(C)).Cells(1, 1)
ZeiC = 1
For Zei = 1 To .Cells(Rows.Count, 3).End(xlUp).Row
If .Cells(Zei, 3) = ActiveSheet.Name Then
ZeiC = ZeiC + 1
.Rows(Zei).Copy Destination:=ActiveSheet.Cells(ZeiC, 1)
End If
Next Zei
Next C
End With
End Sub
Gruß
Reinhard