VBA excel if cell empty delete row above but copy cell from above first

Question

Attached screenshot will explain it better.... I am trying to write macro which will do the following:

When cell A is empty, copy value of cell A from the cell above and delete that row above that cell which was empty… or
In the table shown delete Row 2 but copy cell A2 into A3 before Row 3 deletion

So far I got this but after that I am confused what to do next...anybody can help?

Sub RowAboveDelete()

 Dim ws As Worksheet: Set ws = Sheets("Sheet2")
 Dim lr As Long
 lr = ws.Cells(Rows.Count, 2).End(xlUp).Row

 Dim i As Long
 For i = lr To 1 Step -1
   If IsEmpty(ws.Cells(i, 1)) Then
   ws.Rows(i).Offset(-1).Delete
  
   End If
Next i

End Sub     

Answer 1

Remove Old Data, Keep First Old Column

Main

Sub RemoveOldData()
       
    ' Define constants.
    Const PROC_TITLE As String = "Remove Old Data"
    Const SHEET_NAME As String = "Sheet2"
    Const TOP_LEFT_CELL As String = "A2"
    
    ' Reference the objects.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets(SHEET_NAME)
    Dim rg As Range: Set rg = RefCurrentRegion(ws.Range(TOP_LEFT_CELL))
    Dim crg As Range: Set crg = rg.Columns(1)
    Dim drg As Range
    With rg
        Set drg = rg.Resize(, .Columns.Count - 1).Offset(, 1)
    End With
    
    ' Copy the values from the criteria column to an array.
    Dim cData() As Variant: cData = GetRange(crg)
    ' Retrieve the last (range) row index, the first to be processed.
    Dim cRow As Long: cRow = rg.Rows.Count
    
    ' Declare additional variables.
    Dim RowsCount As Long, TotalRowsCount As Long
    Dim IsCellBlank As Boolean, IsBlankCellFound As Boolean
    
    ' Loop from bottom to top.
    
    Application.ScreenUpdating = False
    
    Do While cRow > 0
        IsCellBlank = (Len(CStr(cData(cRow, 1))) = 0)
        If IsBlankCellFound Then
            RowsCount = RowsCount + 1 ' number of rows to delete
            If Not IsCellBlank Then
                ' Delete rows.
                Union(crg.Rows(cRow + 1).Resize(RowsCount), _
                    drg.Rows(cRow).Resize(RowsCount)).Delete xlShiftUp
                ' Count and reset.
                TotalRowsCount = TotalRowsCount + RowsCount
                RowsCount = 0
                IsBlankCellFound = False
            End If
        Else
            ' Flag.
            If IsCellBlank Then IsBlankCellFound = True
        End If
        cRow = cRow - 1
    Loop
    
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox TotalRowsCount & " row" & IIf(TotalRowsCount = 1, "", "s") _
        & " of old data removed.", _
        IIf(TotalRowsCount = 0, vbExclamation, vbInformation), PROC_TITLE
    
End Sub

Help

Function RefCurrentRegion(topLeftCell As Range) As Range
    
    If topLeftCell Is Nothing Then Exit Function
    
    With topLeftCell.Cells(1).CurrentRegion
        Set RefCurrentRegion = topLeftCell.Resize(.Row + .Rows.Count _
            - topLeftCell.Row, .Column + .Columns.Count - topLeftCell.Column)
    End With

End Function

Function GetRange(ByVal rg As Range) As Variant
    
    If rg Is Nothing Then Exit Function
    
    With rg.Areas(1)
        If rg.Cells.CountLarge = 1 Then
            Dim Data() As Variant: ReDim Data(1 To 1, 1 To 1)
            Data(1, 1) = .Value
            GetRange = Data
        Else
            GetRange = .Value
        End If
    End With
    
End Function