Druckbereich anpassen und Zeilenhöhe anpassen

Sub User_Speichern()
On Error GoTo Fehler
Dim Pfad$, Datei$
Pfad = "Q:\100_Vollzugriff\OSP NEO\Checklistenbearbeitung\"
With Sheets("Checkliste")
If .Range("F7") = "BITTE USERID EINGEBEN" Then
MsgBox "Bitte wählen Sie Ihre UserID in Zelle C7!"
ElseIf .Range("H9") = "Bitte Personennummer auswählen" Then
MsgBox "Bitte geben Sie die Personennummer des Testkunden an"
ElseIf .Range("K7") = "" Then
MsgBox "Bitte geben Sie in K7 ein Datum ein!"
Else
Range("F7:H7").Select
Selection.Copy
Range("F7:H7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H9:K9").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("O16").Select
Selection.Copy
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.Copy
Datei = .Range("C5") & "_" & .Range("C3") & "_" & .Range("I3") & "_" & .Range("C7")  _
_
_
& "_" & Format(Now, "YYYYMMDD") & ".xlsx"
.PageSetup.LeftFooter = Datei
.PageSetup.RightFooter = Format(Now, "DD.MM.YYYY hh:mm")
.PageSetup.RightHeader = "&ISeite &P von &N"
ActiveWorkbook.SaveAs Filename:=Pfad & Datei, _
FileFormat:=xlOpenXMLWorkbook
.PrintOut
ActiveWorkbook.Close False
Range("O14").Select
Selection.Copy
Range("F7:H7").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("O15").Select
Application.CutCopyMode = False
Selection.Copy
Range("H9:K9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("N17").Select
Application.CutCopyMode = False
Range("C7").Select
MsgBox "Vielen Dank für das bearbeiten der Checkliste. Die Daten wurden gespeichert und  _
gedruckt. Bitte geben Sie die unterschriebene Checkliste an die OE210."
Range("B65536").End(xlUp).Offset(0, 0).Select
Selection.ClearContents
End If
End With
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub