Sub DeleteEmptyRows()
  Dim optCalcMode As Long
  Dim nRowsCnt    As Long
  Dim nRow        As Long

  With Worksheets(1)
    If Application.WorksheetFunction.CountA(.Cells) > 0 Then
      optCalcMode = Application.Calculation
      Application.Calculation = xlCalculationManual

      Application.ScreenUpdating = False

      nRowsCnt = .Cells.Find(What:="*", _
            After:=.Range("A1"), SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious).Row - 1

      For nRow = nRowsCnt To 1 Step -1
        If Application.WorksheetFunction.CountA( _
                .Rows(nRow).EntireRow) = 0 Then
          .Rows(nRow).EntireRow.Delete
        End If
      Next nRow

      Application.Calculation = optCalcMode
      Application.ScreenUpdating = True
    End If
  End With
End Sub