Here is a quick way to delete all empty rows on a worksheet:
Below it is code to delete empty rows and columns on a worksheet.
Hope it helps.
Sub DeleteEmptyRowsOnly()
Application.ScreenUpdating = False
Dim r1 As Long, c1 As Integer, rr As Long, cc As Integer, ii As Integer
rr = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
cc = Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
r1 = Cells.Find("*", Cells(rr, cc), , , xlByRows, xlNext).Row
If r1 = 1 Then GoTo 200
Rows("1:" & r1 - 1).Delete
200:
On Error Resume Next
If ActiveSheet.UsedRange.Rows.Count <= 2 Then Exit Sub
rr = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
cc = Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
For ii = 1 To cc
Range([a1], Cells(rr, cc)).AutoFilter Field:=ii, Criteria1:="="
Next
Range([a2], Cells(rr, cc)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Range([a1], Cells(rr, cc)).AutoFilter
End Sub
----------------------------------------------------------------------------------------
Sub DeleteEmptyRowsColumns()
Application.ScreenUpdating = False
Dim r1 As Long, c1 As Integer, rr As Long, cc As Integer, ii As Integer
Dim col As String, c As Integer
rr = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
cc = Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
r1 = Cells.Find("*", Cells(rr, cc), , , xlByRows, xlNext).Row
c1 = Cells.Find("*", Cells(rr, cc), , , xlByColumns, xlNext).Column
If r1 = 1 Then GoTo 100
Rows("1:" & r1 - 1).Delete
100:
If c1 = 1 Then GoTo 200
col = ColLetter(c1 - 1)
Columns("A:" & col).Delete
200:
On Error Resume Next
If ActiveSheet.UsedRange.Rows.Count <= 2 Then GoTo 300
rr = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
cc = Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
For ii = 1 To cc
Range([a1], Cells(rr, cc)).AutoFilter Field:=ii, Criteria1:="="
Next
Range([a2], Cells(rr, cc)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Range([a1], Cells(rr, cc)).AutoFilter
300:
For c = cc To 1 Step -1
If WorksheetFunction.CountA(Columns(c)) = 0 Then Columns(c).Delete
Next
On Error GoTo 0
End Sub
Function ColLetter(ColNumber)
ColLetter = Replace(Split(Columns(ColNumber).Address, ":")(0), "$", "")
End Function