Vba that moves cells with text, (up and to left, insert row/ insert copied cell)

Here is the macro with some explanatory comments. I hope this helps.

Sub MoveCells()
    Application.ScreenUpdating = False 'turns screen refreshing off to prevent screen flickering and speed up the macro
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'finds last row with data
    Dim rng As Range
    For Each rng In Range("D1:D" & LastRow) 'loops through all the cells in column D
        If rng <> "" Then 'checks to make sure the cell is not blank
            Rows(rng.Row).Insert 'inserts blank row above
            rng.Resize(1, 3).Cut Cells(rng.Row - 1, 1) 'resizes the range to include columns D, E and F and then cuts it to the blank row above
        End If
    Next rng
    Application.ScreenUpdating = True 'turns screen refreshing back on
End Sub