Sub Add_Link()
With ActiveWorkbook.ActiveSheet
Dim A, B As Range
rw =  0 
For Each A In Selection
If A.Value <> "" And IsNumeric(A.Value) Then _

For Each i In subfolder
    For Each j In fs.GetFolder(i).Files
        If j.Name Like ("*" & A.Value & "*") Then
            Cells(A.Row, A.Column).Value = i.Name
            Cells(rw +  1 ,  2 ).Value = j.Name
            B.Formula = "=Hyperlink( i.Name & "\" & ".pdf", """ & A.Value & """)"
        End If
        rw = rw +  1 
Next
Next

Next
End With
End Sub

Sub Скрипт()
Dim fs, folder, subfolder, NOF, rw
Dim Cll As Range
Set fs = CreateObject("Scripting.FileSystemObject")
Set folder = fs.GetFolder("моя музыка\111\" & ActiveSheet.Name)

For Each Cll In Range("A:A")

If Cll.Value <> "" And IsNumeric(Cll.Value) Then
    
    For Each NOF In folder.Files
        
        If NOF.Name Like "*_" & Cll.Value & "_*" Then
            
            Cells(Cll.Row,  2 ).Formula = "=Hyperlink(""моя музыка\111\" & ActiveSheet.Name & "\" & NOF.Name & ", """ & Cll.Value & """)"
        
        End If
    
    Next

End If

Next

End Sub

Cells(Cll.Row,  2 ).Formula = "=Hyperlink(  """ & NOF & """ , """ & Cll.Value & """ )"