AW: zeilenweise auf ein neues Tabellenblatt
11.12.2007 15:58:39
Rudi
Hallo,
Sub tt()
Dim c As Range, wks As Worksheet
For Each c In Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants)
If c.Row > 1 And Not SheetExists(c.Value) Then
Set wks = Worksheets.Add(after:=Sheets(Sheets.Count))
c.Parent.Rows(1).Copy wks.Range("A1")
c.EntireRow.Copy wks.Range("A2")
wks.Name = c.Value
End If
Next
End Sub
Function SheetExists(strSheetName As String) As Boolean
Dim wks As Worksheet
For Each wks In Sheets
If wks.Name = strSheetName Then
SheetExists = True
Exit Function
End If
Next
End Function
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe