Repeating a macro til bottom line of data is reached

[aquelious]

I have the below macro that finds a blank cell in column A, then cuts the data from the row and pastes it into the row above in column C then deletes the empty row.
I want this to continue until I reach the last row of data in the spreadsheet but an struggling to work out how to do this.

Can anyone help?

Sub Macro1()
Dim ws As Worksheet
Dim x As Integer
Dim i As Long
Set ws = ActiveSheet
For Each cell In ws.Columns(1).Cells
If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
ActiveCell.Offset(RowOffset:=-1, ColumnOffset:=2).Select
ActiveSheet.Paste
Range("A1").Select
For Each cell In ws.Columns(1).Cells
If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
Range(Selection, Selection.End(xlToRight)).Delete

End Sub

 

[Fluff]

How about

Sub aquelious()
    Dim Cl As Range, Rng As Range
    
    For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlBlanks)
        Range(Cl.Offset(, 1), Cl.Offset(, 1).End(xlToRight)).Copy Cl.Offset(-1, 2)
        If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
    Next Cl
    If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub