Maybe:

Sub nigelld()
Dim i As Long
For i = Range("B" & Rows.count).End(3)(1).Row To 2 Step -1

    If Range("A" & i).Value <> "" Then
        Range("A" & i).offset(1, 1).Cut Range("A" & i).offset(, 1)
        Rows(i + 1).Delete
    End If
Next i
End Sub