Hallo zusammen,

ich habe ein Makro geschrieben, wo ich ein PDF aus einem Tabellenblatt einen bestimmten Bereich erzeuge. Dies habe ich bei mehreren Tabellenblättern gemacht und funktioniert. Jetzt will ich noch ein zusätzliches PDF erzeugen, welche alle in ein PDF zusammenfasst.

Hat da jemand eine Idee und kann mir weiterhelfen? Steh da voll auf dem Schlauch und habe kein Anhaltspunkt. Anbei das Makro unten:

Danke vorab schon mal und Grüße
Uwe

Sub PDFerzeugen()
'
' PDFerzeugen Makro
'

'
Static Zaehler As Integer
Zaehler = Zaehler + 1: If Zaehler > 1 Then Exit Sub

Dim Pfad As String
Dim Pfadneu As String
Dim DateiName As String
Dim Tagesergebnis As String
Dim PDFTagesergebnis As String
Dim DruckbereichTagesergebnis As String
Dim letztezeileTagesergebnis As String
Dim RLgesamt As String
Dim PDFRLgesamt As String
Dim DruckbereichRLgesamt As String
Dim letztezeileRLgesamt As String
Dim RL180 As String
Dim PDFRL180 As String
Dim DruckbereichRL180 As String
Dim letztezeileRL180 As String
Dim RLSpiele As String
Dim PDFRLSpiele As String
Dim DruckbereichRLSpiele As String
Dim letztezeileRLSpiele As String
Dim RLSL As String
Dim PDFRLSL As String
Dim DruckbereichRLSL As String
Dim letztezeileRLSL As String
Dim RLHF As String
Dim PDFRLHF As String
Dim DruckbereichRLHF As String
Dim letztezeileRLHF As String
Dim RLTop5 As String
Dim PDFRLTop5 As String
Dim DruckbereichRLTop5 As String
Dim letztezeileRLTop5 As String
Dim StartDatum As String
Dim StartErgebnisse As String
Dim StartPlatzierung As String
Dim StopPlatzierung As String
Dim BereichPlatzierung As String
Dim Teilnahmen As String
Dim PDFTeilnahmen As String
Dim DruckbereichTeilnahmen As String
Dim letztezeileTeilnahmen As String


Sheets("Einzelergebnisse").Select
StartDatum = Range("M3").Value
StartPlatzierung = Range("M13").Value
StartErgebnisse = Range("M4").Value
StartErgebnisseTop5 = Range("M12").Value
Range("M15").Value = StartPlatzierung
Range("M15").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Pfad = Range("M5").Value
Pfadneu = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\"))
DateiName = Range("M10").Value

Tagesergebnis = (DateiName) & (" ") & ("Tagesergebnis") & ".PDF"
PDFTagesergebnis = (Pfadneu) & ("\") & (Tagesergebnis)
RLgesamt = (DateiName) & (" ") & ("Rangliste gesamt") & ".PDF"
PDFRLgesamt = (Pfadneu) & ("\") & (RLgesamt)
RL180 = (DateiName) & (" ") & ("Rangliste 180") & ".PDF"
PDFRL180 = (Pfadneu) & ("\") & (RL180)
RLSpiele = (DateiName) & (" ") & ("Rangliste Spiele") & ".PDF"
PDFRLSpiele = (Pfadneu) & ("\") & (RLSpiele)
RLSL = (DateiName) & (" ") & ("Rangliste Short Legs") & ".PDF"
PDFRLSL = (Pfadneu) & ("\") & (RLSL)
RLHF = (DateiName) & (" ") & ("Rangliste High Finish") & ".PDF"
PDFRLHF = (Pfadneu) & ("\") & (RLHF)
RLTop5 = (DateiName) & (" ") & ("Rangliste Top5") & ".PDF"
PDFRLTop5 = (Pfadneu) & ("\") & (RLTop5)
Teilnahmen = (DateiName) & (" ") & ("Teilnahmen") & ".PDF"
PDFTeilnahmen = (Pfadneu) & ("\") & (Teilnahmen)



Sheets("Gesamtergebnis").Select
Range("A4").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

Sheets("Ausdruck Tagesergebnis").Select
ActiveSheet.Unprotect
letztezeileTagesergebnis = Range("A500").Value
'MsgBox letztezeileTagesergebnis
DruckbereichTagesergebnis = ("A1") & (":") & ("R") & (letztezeileTagesergebnis)
'MsgBox DruckbereichTagesergebnis
ActiveSheet.Range(DruckbereichTagesergebnis).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFTagesergebnis, Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("Ausdruck RL-gesamt").Select
ActiveSheet.Unprotect
letztezeileRLgesamt = Range("A500").Value
'MsgBox letztezeileRLgesamt
DruckbereichRLgesamt = ("A1") & (":") & ("V") & (letztezeileRLgesamt)
'MsgBox DruckbereichRLgesamt
ActiveSheet.Range(DruckbereichRLgesamt).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFRLgesamt, Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("Ausdruck RL-180").Select
ActiveSheet.Unprotect
letztezeileRL180 = Range("A500").Value
'MsgBox letztezeileRL180
DruckbereichRL180 = ("A1") & (":") & ("D") & (letztezeileRL180)
'MsgBox DruckbereichRL180
ActiveSheet.Range(DruckbereichRL180).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFRL180, Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("Ausdruck RL-Spiele").Select
letztezeileRLSpiele = Range("A500").Value
'MsgBox letztezeileRLSpiele
DruckbereichRLSpiele = ("A1") & (":") & ("G") & (letztezeileRLSpiele)
'MsgBox DruckbereichRLSpiele
ActiveSheet.Range(DruckbereichRLSpiele).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFRLSpiele, Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("Ausdruck RL-SL").Select
letztezeileRLSL = Range("A500").Value
'MsgBox letztezeileRLSL
DruckbereichRLSL = ("A1") & (":") & ("Q") & (letztezeileRLSL)
'MsgBox DruckbereichRLSL
ActiveSheet.Range(DruckbereichRLSL).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFRLSL, Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("Ausdruck RL-HF").Select
letztezeileRLHF = Range("A500").Value
'MsgBox letztezeileRLHF
DruckbereichRLHF = ("A1") & (":") & ("BP") & (letztezeileRLHF)
'MsgBox DruckbereichRLHF
ActiveSheet.Range(DruckbereichRLHF).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFRLHF, Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("Ausdruck RL-Top5").Select
ActiveSheet.Unprotect
letztezeileRLTop5 = Range("A500").Value
'MsgBox letztezeileRLTop5
DruckbereichRLTop5 = ("A1") & (":") & ("D") & (letztezeileRLTop5)
'MsgBox DruckbereichRLTop5
ActiveSheet.Range(DruckbereichRLTop5).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFRLTop5, Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("Ausdruck RL-Anzahl_TN").Select
letztezeileTeilnahmen = Range("A500").Value
'MsgBox letztezeileTeilnahmen
DruckbereichTeilnahmen = ("A1") & (":") & ("C") & (letztezeileTeilnahmen)
'MsgBox DruckbereichTeilnahmen
ActiveSheet.Range(DruckbereichTeilnahmen).ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFTeilnahmen, Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("Einzelergebnisse").Select
Range("M10").Select

End Sub