Hallo Zusammen,

ich habe in einer .xlsb Exceldatei zwei Tabellenblätter:

"KST" --> Hier liegen im Bereich A2:A17 16 verschiedene Kostenstellen als String

"Immo" --> Hier ist ein Bericht (Anzeige von Planwerten Umsatz/Ertrag etc.) welche sich nach der Kostenstelle als Kriterium verändern. Die Daten dazu liegen in einer Datenbank. Ein kopieren der Kostenstelle reicht, damit sich die Werte verändern.

Per "Knopfdruck" soll nacheinander für jede Kostenstelle die Werte ermittelt werden und der Tabellenreiter "Immo" als pdf gedruckt werden.

Soweit so schwer.

Ich bin in VBA grob so vorgegangen:

Schleife, wenn die Kostenstelle KST.A2 mit dem Kriterium Immo.C7 übereinstimmt, drucke das pdf. Danach nehme KST.A3 und kopiere das nach Immo.C7. Danach wieder Druck des pdf. Die Dateinamen orientieren sich am Kriterium.

Das Skript bricht leider an verschiedenen Stellen ab (Mal Laufzeitfehler 9 mal öffnet er eine neue Exceldatei mit den Werten, welche er eigentlich als pdf abspeichern soll). 

Ich habe dazu ein VBA Skript gebastelt:

Sub Kriterien_tauschen()

Dim KritAktuell, KritVorher As Long
Dim ZeileListe, ZeileVerteilung As Long
Dim SpalteVerteiler As Long
Dim BlattDruck, BlattKrit As String
Dim KritDruck As Long
Dim ZeileKrit, SpalteKrit As Long

BlattDruck = "Immo"
BlattKrit = "KST"

ZeileVerteilung = 2
SpalteVerteiler = 1
ZeileKrit = 49
SpalteKrit = 8

KritVorher = Sheets(BlattKrit).Cells(ZeileVerteilung, SpalteVerteiler)
KritAktuell = 0

For ZeileListe = ZeileVerteilung To F_LetzteZeile(BlattKrit)

    'Was ist die Kostenstelle der aktuellen Zeile?
    KritAktuell = Sheets(BlattDruck).Cells(ZeileKrit, SpalteKrit)

    If KritAktuell = KritVorher Then
            
      'Zeile im Blatt Krit markieren und kopieren
      Sheets(BlattKrit).Cells(ZeileVerteilung, SpalteVerteiler).Select
      Application.CutCopyMode = False
      Selection.Copy
            
      'Wechsel zum Blatt Druck und einfügen
      Sheets(BlattDruck).Cells(ZeileKrit, SpalteKrit).Select
      ActiveSheet.PasteSpecial Paste:=xlPasteValues
            
      'Variable für "Zeilenvorschub" auf Blatt Krit erhöhen
      ZeileVerteilung = ZeileVerteilung + 1
    
    'Wenn eine neue Kostenstelle dran ist
    Else
      
      Call Pdf_Druck
      
      'Und weiter geht es mit dem kopieren und einfügen
      'Zeile im Blatt Liste markieren und kopieren
      Sheets(BlattKrit).Cells(ZeileVerteilung, SpalteVerteiler).Select
      Application.CutCopyMode = False
      Selection.Copy

      'Wechsel zum Blatt VERTEILUNG und einfügen
      Sheets(BlattDruck).Cells(ZeileKrit, SpalteKrit).Select
      ActiveSheet.PasteSpecial Paste:=xlPasteValues
            
      ZeileVerteilung = ZeileVerteilung + 1 'Zeilenvorschub
       
    
End If

      KritVorher = KritAktuell

Next

      'ZeileVerteilung
      Call Pdf_Druck
      
      
MsgBox ("Vorgang abgeschlossen")

End Sub

Public Function F_LetzteZeile(BlattKrit)

    'Hier wird die letzte Zeile ermittelt
    'Egal in welcher Spalte sich die letzte Zeile befindet
    'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben
    
    Dim LETZTEZEILE
    
    F_LetzteZeile = Sheets(BlattKrit).UsedRange.SpecialCells(xlCellTypeLastCell).Row
   
End Function

Public Sub Pdf_Druck()

Dim Dateiname As String

Dateiname = Range("H47") & Range("H49") & ".pdf"

Range("C1:BJ34").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Dateiname, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End Sub