Warum 11 Seiten?!

[Mounzer]

Hallo liebe Community,

ich habe mir u.a. Makro zusammengebastelt, das funktioniert auch super, nur verstehe ich nicht, wieso er mir eine PDF-Datei erstellt die 11 Seiten groß ist, obwohl, wenn alles angeklickt wäre, ich nur auf maximal 4 Seiten kommen würde. Kann mir jemand sagen, woran das liegen könnte? :(

Danke

Code:

Code:

Option Explicit
Sub MW_AbteilungsVerteilerMailVersand()
   Dim oAppOutlook As Object
   Dim i As Long
   Dim sAbteilung As String
   Dim sTemp As String

     sAbteilung = Sheets("Tabelle1").Cells(1, 2).Value
     sTemp = ""
    
     With Sheets("Tabelle1")
         For i = 4 To .UsedRange.Rows.Count + .UsedRange.Row - 1
             If .Cells(i, 1).Value = sAbteilung Then
                 sTemp = sTemp & .Cells(i, 9).Value & ";"
             End If
         Next i
         'Das letzte Semikolon entfernen
         If Trim(sTemp) <> "" Then
             sTemp = Left(sTemp, Len(sTemp) - 1)
         End If
     End With
    
     'Wenn mindestens eine E-Mail Adresse gefunde wurde wird
     'eine E-Mail vorbereitet:
     If Trim(sTemp) <> "" Then
        
         Set oAppOutlook = CreateObject("Outlook.Application")
         With oAppOutlook.CreateItem(0)
              .To = sTemp 'Unser E-Mail Empfänger String aus sTemp
              .Subject = Sheets("Tabelle1").Cells(2, 2).Value
              .body = Sheets("Tabelle1").Cells(3, 2).Value
              .Display 'E-Mail anzeigen
              .ReadReceiptRequested = 1  'Lesebestätigung
              .BCC = Sheets("Tabelle1").Cells(1, 4).Value   'Blindkopie
              '.Send = Direkt senden
         End With
    
     Else
    
         MsgBox "Es sind keine Empfänger ausgewählt, " & _
             "die übernommen werden können."
    
     End If
    
     Set oAppOutlook = Nothing
End Sub
Sub AlsPDFSpeichern()
 Dim pdfName As String
 Dim pdfOpenAfterPublish As Boolean
 Dim olApp As Object
 Dim i As Long
 Dim sAbteilung As String
 Dim bAbteilung As String
 Dim sTemp As String
 Dim bTemp As String
 ' Daten kopieren
 Dim Zeile As Long
 Dim ZeileMax As Long
 Dim n As Long
 'Tabellenblatt 2 löschen
 Worksheets(2).UsedRange.ClearContents
 Worksheets(2).UsedRange.ClearFormats
 
'Übermittel alle Verteiler
With Tabelle1
ZeileMax = .UsedRange.Rows.Count
n = 5
For Zeile = 2 To ZeileMax
If .Cells(Zeile, 1).Value = "x" Then
.Rows(Zeile).Copy Destination:=Tabelle2.Rows(n)
n = n + 1
End If
Next Zeile
End With
 
     sAbteilung = Sheets("Tabelle1").Cells(1, 2).Value
     sTemp = ""
    
     With Sheets("Tabelle1")
         For i = 4 To .UsedRange.Rows.Count + .UsedRange.Row - 1
             If .Cells(i, 1).Value = sAbteilung Then
                 sTemp = sTemp & .Cells(i, 9).Value & ";"
             End If
         Next i
         'Das letzte Semikolon entfernen
         If Trim(sTemp) <> "" Then
             sTemp = Left(sTemp, Len(sTemp) - 1)
         End If
     End With
 
 bAbteilung = Sheets("Tabelle1").Cells(1, 3).Value
     bTemp = ""
    
     With Sheets("Tabelle1")
         For i = 4 To .UsedRange.Rows.Count + .UsedRange.Row - 1
             If .Cells(i, 1).Value = bAbteilung Then
                 bTemp = bTemp & .Cells(i, 9).Value & ";"
             End If
         Next i
         'Das letzte Semikolon entfernen
         If Trim(sTemp) <> "" Then
             sTemp = Left(sTemp, Len(sTemp) - 1)
         End If
     End With
 
 
Worksheets("Tabelle2").PageSetup.PrintArea = ("$A$5:$J" & i + 1) 'Automatisch Druckbereich anpassen
  Rem Rückfragen, ob Datei nach dem Erstellen geöffnet werden soll
 If MsgBox("Soll die PDF-Datei nach dem Erstellen angezeigt werden?", vbYesNo, "PDF anzeigen?") = vbYes Then pdfOpenAfterPublish = True
 Rem Pfad und Name der PDF-Datei
 pdfName = ThisWorkbook.Path & "\" & Sheets("Tabelle1").Cells(2, 4) & ".pdf" 'Bezeichnung der PDF-Datei in Bezug auf eine Zelle
 Rem PDF-Datei erstellen. Funktioniert nur in Excel 2007 oder höher, nicht in Excel 2003 oder älter
 Sheets("Tabelle2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
 Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
 OpenAfterPublish:=IIf(pdfOpenAfterPublish, True, False)

 Rem Email erstellen
 Set olApp = CreateObject("Outlook.Application")
 With olApp.CreateItem(0)
 .To = sTemp 'Unser E-Mail Empfänger String aus sTemp
 .BCC = bTemp
 .Subject = Sheets("Tabelle1").Cells(2, 2).Value
 .body = Sheets("Tabelle1").Cells(3, 2).Value
 .Attachments.Add pdfName
 .Display
 End With
 Rem Boolean-Variable "pdfOpenAfterPublish" zurücksetzen
 pdfOpenAfterPublish = False
 End Sub

[schauan]

Hallöchen,

nimm mal in diese Zeile einen Haltepunkt:
Worksheets("Tabelle2").PageSetup.PrintArea = ("$A$5:$J" & i + 1) 'Automatisch Druckbereich anpassen

und schaue, wie groß i ist.

Dann kannst Du mal nachschauen, wo i eigentlich gebildet wird. Da findest Du die Zeile:
For i = 4 To .UsedRange.Rows.Count + .UsedRange.Row - 1

Die Zeilenzahl liegt dann bei .UsedRange.Rows.Count + .UsedRange.Row - 1

Wenn Dein usedRange in A5 los geht, ist alles gut. Geht er in A500 los, bekommst Du ein paar Seiten zu viel.

Ist aber eher Theorie. Das Problem wird anderswo liegen. Beim Export kannst Du nicht einstellen, das alle Spalten auf ein Blatt passen sollen oder das eine Skalierung wirken soll. Beim "normalen" Druck geht das schon. Du müsstest aber eigentlich sehen, wenn z.B. auf den Blättern, die zuviel sind, Daten drauf sind und wo die eigentlich hin gehören …

Eine andere Ursache können Leerzeichen sein. Sieht man nicht, spürt man aber :22: