Loop not finishing

Try this,

With the original data in sheet 2 of the second sample, select A1 and run the code, with the earlier sample, select BE1 and run it.

Sub move_data()
Application.ScreenUpdating = False
Dim rng As Range, ctr As Long
Set rng = Intersect(ActiveSheet.UsedRange, ActiveCell.Resize(1, 4).EntireColumn)
ctr = 1
Do Until rng.Rows.Count - (ctr * 100) < 0
    Range(rng((ctr * 100) + 1, 1), rng((ctr * 100) + 100, 4)).Cut rng.Offset(, ctr * 4)
    ctr = ctr + 1
Loop
Application.ScreenUpdating = True
End Sub