bonjour Nicolas , bonjour @+Thierry
quand il s'agit de faire des usines à gaz je ne suis pas le dernier ….
La macro ci dessous est à placer dans un classeur qui sera dans le meme repertoires que tous les fichiers sources( chemin à adapter dans la macro )
les fichiers sources doivent etre fermés avant le lancement de la recherche
.Tu lances la macro "chercheDansPlusieursFichiers" , une boite de dialogue s'affiche pour saisir le mot à rechercher , puis tu cliques sur OK .
Un message affiche le resultat de la recherche
tu auras certainement quelques adaptations à faire dans la macro , pour ton projet
Sub chercheDansPlusieursFichiers()
Dim X As Integer, nbFichiers As Integer
Dim Tableau(), Tableau2()
Dim Direction As String, Cible As String
Dim i As Byte, j As Byte, Z As Byte
Dim Val As Object
Dim firstAddress As String, Resultat As String
Direction = Dir("C:\Mes documents\ex\*.xls") 'adapter chemin
Do While Len(Direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = Direction
Direction = Dir()
Loop
If nbFichiers > 0 Then
Cible = InputBox(" Saisir le mot à rechercher : ", "Recherche", "Le mot")
Application.ScreenUpdating = False
For X = 1 To nbFichiers
If Tableau(X) <> ThisWorkbook.Name Then
Workbooks.Open Tableau(X)
For i = 1 To Sheets.Count
Sheets(i).Activate
With Sheets(i).UsedRange.Cells
Set Val = .Find(Cible, LookIn:=xlValues)
If Not Val Is Nothing Then
firstAddress = Val.Address
Do
Val.Select
Z = Z + 1
ReDim Preserve Tableau2(2, Z)
Tableau2(0, Z - 1) = "Cellule " & Val.Address
Tableau2(1, Z - 1) = Sheets(i).Name
Tableau2(2, Z - 1) = Tableau(X)
Set Val = .FindNext(After:=ActiveCell)
Loop While Not Val Is Nothing And Val.Address <> firstAddress
End If
End With
Next i
ActiveWorkbook.Close
End If
Next
End If
Application.ScreenUpdating = True
Resultat = "Resultat de la recherche sur le mot : " & Cible & Chr(10) & Chr(10)
If Z = 0 Then
Resultat = Resultat & "Pas de resultat lors de la recherche"
Else
For j = 1 To Z
Resultat = Resultat & Tableau2(0, j - 1) & Chr(9) & Tableau2(1, j - 1) & Chr(9) & Tableau2(2, j - 1) & Chr(10)
Next j
End If
MsgBox Resultat
End Sub
bonne soiree
michel