Sub Recherche()
Dim cel As Range, txt$, F$
[B2:B65536].ClearContents
For Each cel In Range("A2", [A65536].End(xlUp))
With Application.FileSearch 'marche jusqu'à Excel 2003
.NewSearch
.RefreshScopes
.LookIn = ThisWorkbook.Path 'adapter éventuellement
.Filename = cel & ".xls"
.SearchSubFolders = True
.Execute
On Error Resume Next 'si le fichier n'existe pas
txt = .FoundFiles(1)
F = "='" & Application.Replace(txt, InStrRev(txt, "\") + 1, 0, "[") & "]Feuil1'!G12"
cel.Offset(, 1).Formula = F
End With
Next
End Sub