[vba]Код
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
[/vba]