I thought I would share what I put together that can be used for multiple sheets. It is borrowed from the answers above, and you do not need to indicate which active range
Sub Zoomitgood() 'this macro will loop through all the sheets and zoom to fit the contents by 'measuring the width and height of each sheet. It will then zoom to 90% of 'the "zoom to fit" setting. Dim WS_Count As Integer Dim i As Integer Dim j As Integer Dim k As Integer Dim maxwidth As Integer Dim width As Integer Dim Height As Integer Dim MaxHeight As Integer Dim zoom As Integer 'First Loop: Loop through each sheet, select each sheet so that each width 'and height can be measured. The width and height are measured in number of 'cells. WS_Count = ActiveWorkbook.Worksheets.Count For i = 1 To WS_Count Worksheets(i).Activate maxwidth = 0 MaxHeight = 0 'Second loop: measure the width of each sheet by running line by line and 'finding the rightmost cell. The maximum value of the rightmost cell will be 'set to the maxwidth variable For j = 1 To 100 width = Cells(j, 100).End(xlToLeft).Column If width >= maxwidth Then maxwidth = width End If Next 'Third loop: measure the height of each sheet by running line by line and 'finding the rightmost cell. The maximum value of the lowest cell will be 'set to the maxheight variable. For k = 1 To 100 Height = Cells(100, k).End(xlUp).Row If Height >= MaxHeight Then MaxHeight = Height End If Next 'Finally, back to loop 1, select the range for zooming. Then set the zoom to '90% of full zoom. Range(Cells(1, 1), Cells(MaxHeight, maxwidth)).Select ActiveWindow.zoom = True zoom = ActiveWindow.zoom ActiveWindow.zoom = zoom * 0.9 Cells(1000, 1000).Select Application.CutCopyMode = False ActiveWindow.ScrollRow = 1 ActiveWindow.ScrollColumn = 1 Next MsgBox "You have been zoomed" Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub