Thousand of blank pages printed !

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