Skalierung geht nicht

Sub tel()
Dim z As Integer, pbAnz As Integer
ActiveSheet.Cells.ClearFormats
ActiveSheet.ResetAllPageBreaks
'Anzahl Personen
z = 2
Do Until (ActiveSheet.Cells(z, 1) = "")
z = z + 1
Loop
z = z - 2
'sortieren
ActiveSheet.Range(Cells(2, 1), Cells(z + 1, 9)).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, OrderCustom:=1, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal
'Format
With ActiveSheet.Range(Cells(1, 1), Cells(1, 9)).Font
.Name = "Arial"
.Size = 16
.Bold = True
End With
With ActiveSheet.Range(Cells(1, 1), Cells(z + 1, 9)).Font
.Name = "Arial"
.Size = 12
End With
With ActiveSheet.Range(Cells(1, 1), Cells(1, 9)).Borders
.LineStyle = xlContinuous
.ColorIndex = 1
.Weight = xlThick
End With
With ActiveSheet.Range(Cells(2, 1), Cells(z + 1, 9)).Borders
.LineStyle = xlContinuous
.ColorIndex = 1
.Weight = xlMedium
End With
With ActiveSheet.Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
ActiveSheet.Range(Rows(1), Rows(z)).AutoFit
ActiveSheet.Range(Columns(1), Columns(9)).AutoFit
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.PrintTitleRows = "$1:$1"
End With
pbAnz = ActiveSheet.HPageBreaks.Count
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = pbAnz + 1
End With
ActiveSheet.Cells(z + 3, 1).Activate
End Sub