Dim intZaehler As Integer
Dim strPfad As String, strDatei As String, vn As String, nn As String
Dim rngName As Range
Dim arrName
Range("F5:F500").ClearContents
intZaehler = 0
strPfad = "Z:\Pfad"
strDatei = Dir(strPfad & "\*.pdf")
If strDatei = "" Then MsgBox "Keine Dateien vorhanden", vbCritical, "Abbruch": Exit Sub
arrName = Split(strDatei, " ")
vn = arrName(1)
nn = arrName(0)
Do
Set rngName = Columns(4).Find(nn, lookat:=xlWhole)
If Not rngName Is Nothing Then
If rngName.Offset(0, 1) = vn Then
If rngName.Offset(0, 2) = "" Then
rngName.Offset(0, 2) = strDatei
Else
intZaehler = intZaehler + 1
rngName.Offset(intZaehler, 2) = strDatei
End If
End If
End If
strDatei = Dir
Loop While strDatei <> ""