VBA: Druck leere Seiten unterbinden

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim WsA As Worksheet
Dim rngLC As Range
Set WsA = ActiveSheet
Set rngLC = LetzteZelle(WsA, 1)
If Not rngLC Is Nothing Then
Application.DisplayAlerts = False
WsA.PageSetup.PrintArea = WsA.Range("A1", rngLC).Address
Application.DisplayAlerts = True
Else
WsA.PageSetup.PrintArea = ""
Cancel = True
End If
End Sub

Public Function LetzteZelle(oWs As Worksheet, _
Optional AnzahlUeberschriften As Long, _
Optional Bereich As Range) As Range
Dim iCol As Integer
Dim lRow As Long, lRowA As Long, lRowE As Long, lRowMax As Long
Dim rngC As Range, rngM As Range
iCol = 1
If Bereich Is Nothing Then Set Bereich = oWs.UsedRange
lRowA = Bereich.Row + AnzahlUeberschriften
lRowE = Bereich.Row + Bereich.Rows.Count - 1
For Each rngC In Bereich.Columns
For lRow = lRowE To lRowA Step -1
If Len(oWs.Cells(lRow, rngC.Column).MergeArea(1).Text) Then
iCol = rngC.Column
lRowMax = Application.WorksheetFunction.Max(1, lRow, lRowMax)
Exit For 'lRow
End If
Next lRow
Next rngC
If lRowMax = 0 Then Exit Function
Set rngM = Bereich.EntireColumn
'jetzt werden eventuell vorhandene Verbundene Zellen,
'die sich nach unten über den soeben ermittelten
'Bereich erstrecken, in diesen mit eingebunden:
Do
lRowE = lRowMax
Set Bereich = Application.Intersect(rngM, oWs.Rows(lRowMax))
For Each rngC In Bereich
With rngC
If .MergeCells Then
lRowMax = Application.WorksheetFunction.Max _
(1, .MergeArea.Row + .MergeArea.Rows.Count - 1, lRowMax)
End If
End With
Next rngC
Loop While lRowMax > lRowE
Set LetzteZelle = oWs.Cells(lRowMax, iCol)
End Function