[SOLVED] deleting empty cells

Hi Truss123, perhaps the following?

Sub erasewe()

    Dim Ws As Worksheet
    Dim RngToSearch As Range, rc As Range
    
    Application.ScreenUpdating = False
    Set Ws = Worksheets("Sheet1")
    Set RngToSearch = Ws.Range(Ws.Cells(1, ActiveCell.Column), Ws.Cells(1000, ActiveCell.Column))
    
    For Each rc In RngToSearch
        If IsEmpty(rc) Then
            rc.Delete shift:=xlUp
        End If
    Next rc
    Application.ScreenUpdating = True

End Sub