Макрос для удаления пустых ячеек в строке

Попробуйте этот код. Он ограничивает его только заполненными строками - при условии, что в столбце A всегда что-то есть.

Public Sub RemoveBlankCells()
    
    With ThisWorkbook.Worksheets("ABC")
    
        'Assume there's always something in column 1.
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).row
        
        'Set reference to column A of the range to work on.
        Dim SearchRange As Range
        Set SearchRange = .Range(.Cells(1, 1), .Cells(LastRow, 1))
        
        Dim rRow As Range
        For Each rRow In SearchRange.EntireRow
            
            'Find the last column number in the row.
            Dim LastColumn As Long
            LastColumn = .Cells(rRow.row, .Columns.Count).End(xlToLeft).Column
            
            'Work backwards deleting cells - if you delete a cell in column 3 and move to column 4...
            'column 4 has now become column 3 and that cell isn't checked.
            Dim Counter As Long
            For Counter = LastColumn To 1 Step -1
                If .Cells(rRow.row, Counter) = "" Then .Cells(rRow.row, Counter).Delete Shift:=xlToLeft
            Next Counter
        Next rRow
        
    End With

End Sub  

Дальнейшее чтение:
With...End With заявление

Этот код использует ActiveSheet.UsedRange. Собирает все пустые ячейки, а затем удаляет и сдвигает влево оставшиеся.

Sub delete_cells()
Dim todel As Range, cel as Range   '*
For Each cel In ActiveSheet.UsedRange
  If Len(cel) = 0 Then
    If todel Is Nothing Then
    Set todel = cel
    Else
    Set todel = Union(todel, cel)
    End If
  End If
Next cel

If Not todel is Nothing Then todel.Delete xlToLeft '*
End Sub

* по состоянию на VBasic2008 с комментарием

Удалить пробелы в строках

Основной

Sub RemoveBlankCells()

    Dim rg As Range

    With ThisWorkbook.Sheets("ABC").Range("A1").CurrentRegion
        Set rg = .Resize(.Rows.Count - 1).Offset(1) ' exclude headers
    End With
    
    RemoveRowBlanks rg
    
End Sub

Помощь

Sub RemoveRowBlanks(ByVal rg As Range)
    
    If rg Is Nothing Then Exit Sub
    
    Dim RowsCount As Long: RowsCount = rg.Rows.Count
    Dim ColumnsCount As Long: ColumnsCount = rg.Columns.Count
    
    Dim Data() As Variant:
    
    If RowsCount + ColumnsCount = 2 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
    Else
        Data = rg.Value
    End If
    
    Dim Row As Long, sCol As Long, dCol As Long, IsNotSameColumn As Boolean
    
    For Row = 1 To RowsCount
        dCol = 0
        IsNotSameColumn = False
        For sCol = 1 To ColumnsCount
            If Len(CStr(Data(Row, sCol))) > 0 Then
                dCol = dCol + 1
                If Not IsNotSameColumn Then
                    If dCol < sCol Then IsNotSameColumn = True
                End If
                If IsNotSameColumn Then
                    Data(Row, dCol) = Data(Row, sCol)
                    Data(Row, sCol) = Empty
                End If
            End If
        Next sCol
    Next Row
    
    rg.Value = Data

End Sub

Попробуйте также этот компактный фрагмент кода. Это быстро и не требует итераций:

Sub testDeletEBlankCellsSlideLeft()
  Dim rng As Range: Set rng = ActiveSheet.UsedRange
  On Error Resume Next 'for the case of no any blank cells in sheet used range...
   rng.SpecialCells(xlCellTypeBlanks).Delete xlToLeft
  On Error GoTo 0
End Sub