Hi liebe community,

ich habe hier eine makro (thx an beverly) das ich noch gerne verbessern würde bzw. für meinen verwendungszweck optimieren möchte.
und zwar geht es darum das ich die dateinamen gleich mit einer hyperlink verknüpfen möchte
kann mir dabei jemand helfen ???

thx im voraus
lg martin


hier das makro:

Sub daten_uebernehmen()
Dim Dateien As Integer
Dim loZeile As Long
Dim strPfad As String
loZeile = 2
strPfad = "C:\Test" ' <== Pfad anpassen
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = strPfad
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
Cells(loZeile, 1) = Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien)))
Cells(loZeile, 2).FormulaLocal = "='" & strPfad & "\" & "[" & _
Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien))) & "]Tabelle1'!D2"
Cells(loZeile, 3).FormulaLocal = "='" & strPfad & "\" & "[" & _
Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien))) & "]Tabelle1'!H13"
Cells(loZeile, 4).FormulaLocal = "='" & strPfad & "\" & "[" & _
Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien))) & "]Tabelle1'!H14"
loZeile = loZeile + 1
Next Dateien
End If
End With
Range("B2:D" & IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)).Copy
Range("B2").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Application.DisplayAlerts = False
End Sub