Try this:

Option Explicit

Sub Model()
    Dim i As Long, lr As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = False
    For i = lr To 2 Step -1
    If Range("A" & i) = "" Then
    Range("A" & i) = Range("A" & i + 1)
    End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "complete"


End Sub