Hallo zusammen,
ich bastele gerade an einem Makro, wie unten stehend.

Ich erzeuge mir ein pdf aus einem bestimmten Bereich, benenne die Datei nach ein paar Parametern, UND VOR ALLEM mit Datumsangabe
Für einen Durchlauf soweit funktioniert das alles gut.


Nun will ich dieses pdf 10 bzw. 15 mal erstellen (also für 2 oder 3 Wochen), jeweils mit dem nächsten Tag im Dateinamen, beginnend mit dem Starttag

Diseer staht in Zelle DO157 und wird für den Dateinamen genommen.

Ich habe versucht den Bereich  'pdf erzuegen'  in eine Schleife zu packen,  und versuche die pdfs mit Datum +1 Werktag.
zu erzeugen.

1. Kenne mich mit Schleifen aber nicht so aus...tu mir da schwer.

2. Ich bekomme schon bei Zeile   "Date = Starttag" "FEHLER 70 ZUGRIFF VERWEIGERT"

3. Jetzt kapier ich garnichts mehr.

Freue mich über Anregungen. Kann mir jemand weiterhelfen?

Danke.......................

Sub T16_12Liste()

    Dim iFile As String
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)
    UserName = Environ("username") 'user
    FolderName = "C:\Users\" & UserName & "\Documents\Verbleib"
    Raum = "Palermo"
    Starttag = Range("DO157")
    Date = Starttag
 
' Sortieren nach Alphabet
 Call Sort_Alpha
       
'Seite einrichten
   With ActiveSheet.PageSetup
        ActiveSheet.PageSetup.PaperSize = xlPaperA4
        ActiveSheet.PageSetup.Orientation = xlPortrait
        .LeftMargin = Application.InchesToPoints(0.2)
        .RightMargin = Application.InchesToPoints(0.2)
        .TopMargin = Application.InchesToPoints(0.58740157480315)
        .BottomMargin = Application.InchesToPoints(0.2)
        .Zoom = 95
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        
        ActiveSheet.PageSetup.PrintArea = _
        Range("T16Basis").Address
 
    End With

'pdf erzuegen Schleife starten
 For i = 1 To 5
  Do
     Starttag = Starttag + 1
        Loop While Weekday(Datum, vbMonday) > 5
        Start = Format(Datum, "dd.mm.yyyy")
   
'pdf erzuegen
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "C:\Users\" & UserName & "\Documents\Verbleib\T16\" & "T16- " & Raum & " " & Starttag & ".pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

'.Save
   'End With
Next i

'ENDE SCHLEIFE

MsgBox ("Die Listen wurde nach C:\Dokumente\Verbleib\T16 kopiert")

' Druckbereich Aufheben()
    ActiveSheet.PageSetup.PrintArea = Range("D58:N142").Address
    ActiveSheet.PageSetup.Orientation = xlLandscape
       
End Sub