Sub DeleteEmptyRows()
'---------------------------------------------------------------------------------------
' Procedure    : DeleteEmptyRows
' Purpose      : Удаление всех пустых строк в выделенном диапазоне
'---------------------------------------------------------------------------------------
   If MsgBox("Удалить все пустые строки в выделенном диапазоне?", vbYesNo + vbQuestion, "Удалить пустые строки?") = vbNo Then Exit Sub
   Dim lLastRow&, i&
   With Intersect(Selection.EntireRow, ActiveSheet.UsedRange)
      lLastRow = .Row - 1 + .Rows.Count
      With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
      For i = lLastRow To 1 Step -1
         If Application.CountA(.Rows(i)) = 0 Then .Rows(i).Delete
      Next i
      With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: End With
   End With
End Sub