Solved: It copy one row not all needed rows

[suny100]

I want my code to copy all similar data (based on value of E) to new sheet which must be the same name of this value as example I have data in column E for classes so I want my code to check this column and all "Math" instances be copied to new sheet with name "Math" and paste data on it
here is my code it works well but it just copy 2 rows not all instances rows , also I think there may be other way simpler than this

Attached is sample file
Please need help

[CatDaddy]

you want it to make a new sheet for each unique value in column E?

[CatDaddy]

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

[suny100]

you want it to make a new sheet for each unique value in column E?

yes that's exactly what i want and this sheet name is = to this unique value

[suny100]

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



Really many many thanks it works well as i need exactly:thumb :thumb :thumb
and thanks for your fast reply

[CatDaddy]

no problem :)