Code:
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMS As Long)
'Option Explicit



Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim objComment
On Error Resume Next
Set objComment = Target.Cells(1, 1).Comment
If Not objComment Is Nothing Then
If InStr(1, objComment.Text, "Series") > 0 And InStr(1, objComment.Text, "Class") > 0 Then
CommandBars("EwShort").ShowPopup
Cancel = True
Else
Cancel = False
End If
End If
End Sub


Sub Drucken_Manager()
 
Dim sPath As String
Dim Betreuer As String
Dim Depot As String
Dim spezialNummer As Integer
Dim masterPath As String
Dim perDatPath As String
Dim perDat As String

spezialNummer = 149
Zeile = 149
ZeileKunde = 150
masterPath = "MK"
Worksheets("Auswahl").Range("V8").Value = spezialNummer
Do While Worksheets("PB-Liste").Cells(Zeile, 2).Value <> ""
    If Worksheets("PB-Liste").Cells(Zeile, 5).Value <> "" Then
        Betreuer = Worksheets("PB-Liste").Cells(Zeile, 4).Value
        Depot = Worksheets("PB-Liste").Cells(Zeile, 5).Value
        Worksheets("Liste").Cells(ZeileKunde, 9).Value = Zeile - 148
        perDat = Worksheets("Kunden").Range("L30").Value
        perDatPath = mk_bp_date(perDat)
        Call ChartKunden
        sPath = masterPath & Betreuer & "\" & perDatPath & "\"
        
        If Dir(sPath, vbDirectory) = "" Then
            Call MakeDir(sPath)
            Else
            'MsgBox "Verzeichnis " & sPath & " Existiert schon"
            'Exit Sub
        End If
    Call PrintToPDF_Early(sPath, Depot)
    Zeile = Zeile + 1
    Else
    Zeile = Zeile + 1
    End If
Loop

End Sub
Sub PrintToPDF_Early(sPDFPATH As String, sPDFName As String)
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
'   (Download from http://sourceforge.net/projects/pdfcreator/)
'   Designed for early bind, set reference to PDFCreator

    Dim pdfjob As PDFCreator.clsPDFCreator
    'Check if worksheet is empty and exit if so
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub

    Set pdfjob = New PDFCreator.clsPDFCreator

    With pdfjob
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Can't initialize PDFCreator.", vbCritical + _
                    vbOKOnly, "PrtPDFCreator"
            Exit Sub
        End If
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sPDFPATH
        .cOption("AutosaveFilename") = sPDFName
        .cOption("AutosaveFormat") = 0    ' 0 = PDF
        .cClearCache
    End With

    'Print the document to PDF
    ActiveSheet.PrintOut Copies:=1, ActivePrinter:="PDFCreator"

    'Wait until the print job has entered the print queue
    Do Until pdfjob.cCountOfPrintjobs = 1
        DoEvents
    Loop
    pdfjob.cPrinterStop = False

    'Wait until PDF creator is finished then release the objects
    Do Until pdfjob.cCountOfPrintjobs = 0
        DoEvents
    Sleep 250
    Loop
    pdfjob.cClose
    Set pdfjob = Nothing
End Sub

Sub ChartKunden()
Worksheets("Kunden").Select
    P = Cells(16, 18).Value
    q = Cells(17, 18).Value
    s = Cells(17, 19).Value
    ActiveSheet.ChartObjects("Chart 12").Activate
    ActiveChart.Axes(xlValue).Select
   On Error Resume Next
    With ActiveChart.Axes(xlValue)
        .MinimumScale = P
        .MaximumScale = q
        .MajorUnit = s
    End With
    Range("O19").Select

End Sub

Sub MakeDir(directory As String)
On Error Resume Next
MkDir directory
End Sub
Function mk_bp_date(dat)
    Jahr = Year(dat)
    Monat = two_dig(Month(dat))
    Tag = two_dig(Day(dat))
    mk_bp_date = Jahr & Monat & Tag
End Function
Function two_dig(num)
    If num < 10 Then
        two_dig = "0" & num
    Else
        two_dig = "" & num
    End If
End Function

Code:

Sub Drucken_Manager()
 
Dim sPath As String
Dim Betreuer As String
Dim Depot As String
Dim spezialNummer As Integer
Dim masterPath As String
Dim perDatPath As String
Dim perDat As String

spezialNummer = 149
Zeile = 149
ZeileKunde = 150
masterPath = "MK"
Worksheets("Auswahl").Range("V8").Value = spezialNummer
Do While Worksheets("PB-Liste").Cells(Zeile, 2).Value <> ""
    If Worksheets("PB-Liste").Cells(Zeile, 5).Value <> "" Then
        Betreuer = Worksheets("PB-Liste").Cells(Zeile, 4).Value
        Depot = Worksheets("PB-Liste").Cells(Zeile, 5).Value
        Worksheets("Liste").Cells(ZeileKunde, 9).Value = Zeile - 148
        perDat = Worksheets("Kunden").Range("L30").Value
        perDatPath = mk_bp_date(perDat)
        Call ChartKunden
        sPath = masterPath & Betreuer & "\" & perDatPath & "\"