OK:-
Sub MoveData()
Dim r As Long
Dim lrow As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lrow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
For r = 4 To lrow Step 3
Cells(r - 1, 5).Value = Cells(r, 4).Value
Cells(r, 4).ClearContents
Next r
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
This starts in D4 and works its way down 3 cells at a time (r = 4 To lrow Step
3). The 5 is Column E and the 4 is column D. Cells(r, 4) is a particular row
in Col D depending on what value r has at the time.