Makro Druckbereich festlegen

Sub DruckbereichFestlegen()
Dim Inp As String, ws As Worksheet, rg As Range
Set ws = ThisWorkbook.Worksheets("Master")
Set rg = ws.Range("A1:A100").Find("Administrator", , xlValues, xlWhole, xlByColumns,  _
xlNext)
If rg Is Nothing Then
MsgBox "Der User 'Administrator' wurde nicht gefunden!", 16, "Fehler!"
Else
Inp = InputBox("Geben Sie das Passwort vom Administrator ein!")
If Crypto(Inp, cKey)  rg.Offset(0, 1).Value Then
MsgBox "Das Passswort ist falsch!", 16, "Fehler!"
Exit Sub
Else
Dim lngI As Long
For lngI = 1 To ActiveWindow.SelectedSheets.Count
With ActiveWindow.SelectedSheets(lngI)
.PageSetup.PrintArea = "B1:H533"
.HPageBreaks.Add before:=Range("B48")
.HPageBreaks.Add before:=Range("B89")
.HPageBreaks.Add before:=Range("B132")
.HPageBreaks.Add before:=Range("B174")
.HPageBreaks.Add before:=Range("B217")
.HPageBreaks.Add before:=Range("B259")
.HPageBreaks.Add before:=Range("B302")
.HPageBreaks.Add before:=Range("B345")
.HPageBreaks.Add before:=Range("B387")
.HPageBreaks.Add before:=Range("B430")
.HPageBreaks.Add before:=Range("B472")
.HPageBreaks.Add before:=Range("B515")
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = ""
Range("D8").Select
End With
Next lngI
End If
End If
Set rg = Nothing
Set ws = Nothing
ActiveSheet.PrintPreview 'Druckansicht
End Sub