[FranzK]

Hi

Na ja, "richtiger Code" ist hier wohl ein wenig übertrieben. Eine erste Verbesserung wäre:

Public Sub Schaltfläche6_Klicken()

  Dim i As Integer
  Dim RootDir As String
  Dim NewDir As String
  Dim Ordnername As String
  Dim fso

  RootDir = "C:\Firma"
  Set fso = CreateObject("Scripting.FileSystemObject")

  'Prüfen ob Ordner 'daten' existiert. Wenn nicht, neu anlegen
  If Len(Dir(RootDir, vbDirectory)) = 0 Then
    MkDir RootDir
  End If
    
  'Jetzt das Ganze für die Unterordner
  For i = 3 To 1000
    Ordnername = Cells(i, 7).Value & " " & Cells(i, 6).Value
    If Trim$(Ordnername) <> "" Then  
      NewDir = RootDir & "\" & Ordnername
      If (fso.FolderExists(NewDir)) = False Then
        MkDir (NewDir)
      End If
    End If
  Next

End Sub