Paritosh,

I tested the code and it works for all non-empty cells in
Column A -- not just the first four (???). A specific
example follows. The headings are in row 1 with Id Num,
Name and Supervisor in cells A1 to C1 respectively. The
data immediately follows as shown below. Gaps are
deliberate indicating blank rows. Following the data list
shown immediately below are the results of the macro run
on these data. This is my interpretation of what you
wanted. Is this not what you get from running the
macro?

<<<< Data

Id Num Name Supervisor
ID1 Name1 Sup1

ID2 Name2 Sup2

ID3 Name3 Sup3
ID4 Name4 Sup4
ID5 Name5 Sup5

ID6 Name6 Sup6
ID7 Name7 Sup7


ID8 Name8 Sup8

<<<<< Macro result in Column E

ID1 Name1 Sup1
ID1 Name1 Sup1
ID1 Name1 Sup1
ID1 Name1 Sup1
ID2 Name2 Sup2
ID2 Name2 Sup2
ID2 Name2 Sup2
ID2 Name2 Sup2
ID3 Name3 Sup3
ID3 Name3 Sup3
ID3 Name3 Sup3
ID3 Name3 Sup3
ID4 Name4 Sup4
ID4 Name4 Sup4
ID4 Name4 Sup4
ID4 Name4 Sup4
ID5 Name5 Sup5
ID5 Name5 Sup5
ID5 Name5 Sup5
ID5 Name5 Sup5
ID6 Name6 Sup6
ID6 Name6 Sup6
ID6 Name6 Sup6
ID6 Name6 Sup6
ID7 Name7 Sup7
ID7 Name7 Sup7
ID7 Name7 Sup7
ID7 Name7 Sup7
ID8 Name8 Sup8
ID8 Name8 Sup8
ID8 Name8 Sup8
ID8 Name8 Sup8

As for your request to change the sheet to a different
sheet, the following code will copy the data from the
active sheet to Sheet("Sheet2") instead of to the active
sheet. Change sheet names and cell references to suit and
correct for wordwrap.

'<<<<< Transfer data
i = 0
Rw = Range("A65536").End(xlUp).Row
Set Rng = Range("A2:A" & Rw).SpecialCells
(xlCellTypeConstants)
For Each C In Rng
For ii = 1 To 4
With Sheets("Sheet2")
.Range(.Cells(i + ii, 5), .Cells(i + ii, 7)) =
Range(C, C.Offset(, 2)).Value
End With
Next
i = i + 4
Next

End Sub

Regards,
Greg