einen wunderschönen guten morgen zusammen....

ich habe mal wieder ein kleines problem und benötige daher eure hilfe......

folgender code erstellt für meine projekte ordnerstrukturen, funktioniert sehr gut.

Nur hätte ich gern, das der code selbstständig bei der ersten leeren zelle in spalte a aufhört zu arbeiten, momentan begrenze ich die

for next schleife noch einfach mit einer zahl. Ich denke dass das mit einer do loop schleife einfach funktionieren wird, wiß aber nicht wie ich das

umschreiben muss, damit es passt...

hier der code...

Private Sub alle_Ordner_neu_Click()


    Dim lngReturn As Long, lngErrorNumber As Long
    Dim strBuffer As String
    Dim intNr As Long
    Dim c As Variant
    Dim counter As Integer
    
    
    With Worksheets("Projektübersicht").Columns(1)
    
    
    
    c = .Cells(ActiveCell.Row, 1).End(xlUp).Row
    
    
    c = c + 4
    
    For c = 4 To 115    'Cells(Rows.Count, 1).End(xlUp).Row
    
    
   
    
                 
    lngReturn = MakeSureDirectoryPathExists("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Auftragsdokumentation_Blanco" & "\")
      
    MakeSureDirectoryPathExists ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Auftragsdokumentation_Rücklauf" & "\" & "\" & "Fotodokumentation" & "\")
    
    MakeSureDirectoryPathExists ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Auftragsdokumentation_Rücklauf" & "\" & "\" & "Durchführungsbestätigungen" & "\")
    
    MakeSureDirectoryPathExists ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Anfrage, Angebot, Projektdaten" & "\" & "\" & "Kundenfotos" & "\")
    
    MakeSureDirectoryPathExists ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Anfrage, Angebot, Projektdaten" & "\" & "\" & "Mailverkehr" & "\")
    
    
    
   
   
    
    If lngReturn = 0 Then
    lngErrorNumber = Err.LastDllError
    strBuffer = Space$(200)
    Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _
    lngErrorNumber, LANG_NEUTRAL, strBuffer, 200, ByVal 0&)
    Call MsgBox("Fehler: " & CStr(lngErrorNumber) & vbLf & vbLf & _
    strBuffer, vbCritical, "Fehler beim Anlegen der Ordner")
    
    Else
    
     If Dir("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Verlauf.txt") = "" Then
        
    Open ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Verlauf.txt") For Output As #1
    
    Print #1, "Projektverlauf:" & " " & "Datei wurde angelegt am:" & " " & Date & "/" & " " & Time & " " & "Für das Projekt:" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " "
    
    Close #1
    
    End If
   

    
    
    
   
     Cells(c, 41).Select
     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3), TextToDisplay:="angelegt am" & " " & Date & " " & "von" & " " & Environ("COMPUTERNAME")  'Hyperlink wird eingefügt


    
    End If
    Next c
    End With
    
    
    Call MsgBox("Die Ordner wurden erfolgreich angelegt.", vbInformation, "Information")
    
    Unload Me
    
    End Sub