Sub ExcelDiet()
Dim x As Integer
Dim LastRow As Long
Dim LastCol As Integer
Application.ScreenUpdating = False
On Error Resume Next
For x = 1 To Sheets.Count
Sheets(x).Activate
LastRow = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(1, LastCol + 1), Cells(65536, 256)).Delete
Range(Cells(LastRow + 1, 1), Cells(65536, 256)).Delete
Next x
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub WorkbookReducer()
'From: http://www.contextures.com/xlfaqApp.html#Unused
' Re-set used range
Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range
For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", After:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", After:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
On Error GoTo 0
If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks
End Sub