Originally Posted by
CatDaddy
[VBA]Sub test()
Dim cell As Range
Dim lr As Long, r As Long
ActiveWorkbook.Sheets(1).Activate
lr = Range("E" & Rows.Count).End(xlUp).Row
For Each cell In Range("E2:E" & lr)
If cell.Value <> cell.Offset(-1, 0).Value Then
ActiveWorkbook.Sheets.Add.Name = cell.Value
r = 1
cell.EntireRow.Copy Destination:=Sheets(cell.Value).Range("A" & r)
r = r + 1
ElseIf cell.Value = cell.Offset(-1, 0).Value Then
cell.EntireRow.Copy Destination:=Sheets(cell.Value).Range("A" & r)
r = r + 1
End If
Next cell
End Sub[/VBA]