It's a little sloppy but here's one way:

Sub test()
Dim countD As Integer, countR As Integer

countD = 2
countR = 4

Do Until Cells(1, countR) = ""
Cells(1, countR).Cut Cells(countD, 2)
Cells(1, countR + 1).Cut Cells(countD, 3)
countR = countR + 2
countD = countD + 1
Loop

End Sub

--
Dan Oakes