Recherche de fichier

Sub RechercheFichier()
Dim nomfich$, refer$, o As Boolean, Cel As Range
Application.ScreenUpdating = False
On Error Resume Next
nomfich = Dir(ThisWorkbook.Path & "\*.xls") '1er fichier du dossier
[COLOR="Red"]refer = Range("A1")[/COLOR] 'le texte recherché
While nomfich <> "" And refer <> ""
If nomfich <> ThisWorkbook.Name Then
  If IsError(Workbooks(nomfich).Name) Then 'si le fichier n'est pas déjà ouvert, on l'ouvre
    Workbooks.Open ThisWorkbook.Path & "\" & nomfich
    o = True
  Else
    Workbooks(nomfich).Activate
    o = False
  End If
  Windows(nomfich).Visible = True 'au cas où la fenêtre serait masquée, on l'affiche
  Set Cel = Sheets(1).Cells.Find(What:=refer, LookIn:=xlFormulas, LookAt:=xlWhole) 'recherche dans la 1ère feuille du fichier
  If Cel Is Nothing Then 'si la recherche n'aboutit pas
    If o Then ActiveWorkbook.Close SaveChanges:=False 'si le fichier a été ouvert, on le referme
  Else 'si le texte est trouvé
    Sheets(1).Activate
    Application.ScreenUpdating = True
    Cel.Select 'la cellule trouvée est sélectionnée et la macro s'arrête là
    Exit Sub
  End If
End If
nomfich = Dir 'fichier suivant du dossier
Wend
ThisWorkbook.Activate
Application.ScreenUpdating = True
End Sub

Sub RechercheFichier()
Dim nomfich$, refer$, i%, o As Boolean, Cel As Range
Application.ScreenUpdating = False
On Error Resume Next
nomfich = Dir(ThisWorkbook.Path & "\*.xls") '1er fichier du dossier
refer = Range("A1") 'le texte recherché
i = 0
While nomfich <> "" And refer <> ""
If nomfich <> ThisWorkbook.Name Then
  If IsError(Workbooks(nomfich).Name) Then 'si le fichier n'est pas déjà ouvert, on l'ouvre
    Workbooks.Open ThisWorkbook.Path & "\" & nomfich
    o = True
  Else
    Workbooks(nomfich).Activate
    o = False
  End If
  Windows(nomfich).Visible = True 'au cas où la fenêtre serait masquée, on l'affiche
  Set Cel = Sheets(1).Cells.Find(What:=refer, LookIn:=xlFormulas, LookAt:=xlWhole) 'recherche dans la 1ère feuille du fichier
  If Cel Is Nothing Then 'si la recherche n'aboutit pas
    If o Then ActiveWorkbook.Close SaveChanges:=False 'si le fichier a été ouvert, on le referme
  Else 'si le texte est trouvé
    Sheets(1).Activate
    [COLOR="Red"]Application.Goto Cel.Address(ReferenceStyle:=xlR1C1), True[/COLOR] 'cadre la cellule trouvée dans le coin supérieur gauche
    i = i + 1
  End If
End If
nomfich = Dir 'fichier suivant du dossier
Wend
ThisWorkbook.Activate
Application.ScreenUpdating = True
MsgBox IIf(i, "Référence dans " & i & " fichier(s).", "Référence introuvable.")
End Sub