Sub ResetAllUsedRanges()
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
ResetUsedRange wks
Next wks
End Sub
Sub ResetUsedRange(Optional wks As Worksheet)
Dim lngLastRow As Long, lngLastCol As Long, lngRealLastRow As Long, lngRealLastCol As Long
On Error Resume Next
If wks Is Nothing Then Set wks = ActiveSheet
With wks
With .Range("A1").SpecialCells(xlCellTypeLastCell)
lngLastRow = .Row
lngLastCol = .Column
End With
lngRealLastRow = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
lngRealLastCol = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
If lngRealLastRow < lngLastRow Then .Range(.Cells(lngRealLastRow + 1, 1), .Cells(lngLastRow, 1)).EntireRow.Delete
If lngRealLastCol < lngLastCol Then .Range(.Cells(1, lngRealLastCol + 1), .Cells(1, lngLastCol)).EntireColumn.Delete
Debug.Print .UsedRange.Count
End With
End Sub