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

Sub DeleteEmptyRows()
    Dim r As Long, rng As Range
    For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
        If Application.CountA(Rows(r)) = 0 Then
            If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r))
        End If
    Next r
    If Not rng Is Nothing Then rng.Delete
End Sub

Sub DeleteEmptyRowsInRange()
    Dim r As Long, rng As Range
    For r = 1 To Selection.Rows.Count
        If Application.CountA(Selection.Rows(r)) = 0 Then
            If rng Is Nothing Then
                Set rng = Selection.Rows(r)
            Else
                Set rng = Union(rng, Selection.Rows(r))
            End If
        End If
    Next r
    If Not rng Is Nothing Then rng.Delete
End Sub

Sub DeleteEmptyRowsInRange()
    Dim r As Long, rng As Range
    Range("B3:B10").Copy Range("H3:H10")
    Range("H3:H10").Select
    For r = 1 To Selection.Rows.Count
        If Application.CountA(Selection.Rows(r)) = 0 Then
            If rng Is Nothing Then
                Set rng = Selection.Rows(r)
            Else
                Set rng = Union(rng, Selection.Rows(r))
            End If
        End If
    Next r
    If Not rng Is Nothing Then rng.Delete
     Range("H3:H10").Copy Range("B3:B10")
     Range("H3:H10").ClearContents
End Sub 

If Application.CountA(Rows(r)) <> 0 Then Rows(r).Delete   'если в строке пусто - удаляем ее

Sub DeleteEmptyColumns()
    LastCol = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count    
    Application.ScreenUpdating = False
    For r = LastCol To 1 Step -1         
        If Application.CountA(Columns(r)) = 0 Then Columns(r).Delete
    Next r
End Sub