Attribute VB_Name = "DeleteBlankRows"
' Deletes every fully-blank row in the used range of the active sheet.
Sub DeleteBlankRows()
    Dim ws As Worksheet, r As Long, lastRow As Long
    Set ws = ActiveSheet
    lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
    Application.ScreenUpdating = False
    For r = lastRow To 1 Step -1
        If Application.WorksheetFunction.CountA(ws.Rows(r)) = 0 Then ws.Rows(r).Delete
    Next r
    Application.ScreenUpdating = True
    MsgBox "Blank rows removed.", vbInformation
End Sub