Полезный макрос для построения списка всех файлов в текущей директории

Sub Hyperlinka()

Dim h As Hyperlink
Dim strCell As String
Dim file As String

Dim directory As String
Dim filename As String
Dim filenames As New Collection

directory = ActiveWorkbook.Path
filename = dir(directory & "\*.*")
 
Do While filename <> ""
   If filename <> ActiveWorkbook.Name Then
       filenames.Add filename
   End If
   filename = dir
Loop
    
For cell = 1 To filenames.Count
    strCell = "A" + CStr(cell)
    filename = filenames.Item(cell)
    ActiveSheet.Hyperlinks.Add Anchor:=Range(strCell), Address:= _
    filename, TextToDisplay:=filename
Next

End Sub