Repeat cutting and pasting to the row below

Hello,
I am trying to create a macro loop that cut every row at the D column and paste it to the next row starting at the A column, until there is no more data on the D column. The following is the backbone of my macro, they are not functional, the underlined ones are what I would like to be replaced by actual correct coding.

Sub Cut_Paste()

Dim n as Integer

Loop n = 1, infinity

Range("D .n").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("A .(n+2)").Select
ActiveSheet.Paste

Loop Until if D .(n+2) == empty cell

End Sub