Option Explicit
Sub Ordner_anlegen() Dim lRowsCount& For lRowsCount = 2 To 101 If Cells(lRowsCount, 4) = "" Then Exit Sub With Worksheets("Kunden") If Dir("C:\Geschäft\Kunden\" & .Range("D" & lRowsCount), vbDirectory) = "" Then MkDir ("C:\Geschäft\Kunden\" & .Range("D" & lRowsCount)) ActiveSheet.Hyperlinks.Add Anchor:=.Range("A" & lRowsCount), _ Address:="C:\Geschäft\Kunden\" & .Range("D" & lRowsCount), TextToDisplay:="1", ScreenTip:="Hyperlink" End If End With Next lRowsCount End Sub