[COLOR="RoyalBlue"]Sub OnyGo()[/COLOR]
[COLOR="SeaGreen"]'**************** Répertoire ou lecteur où chercher **********[/COLOR]
Répertoire = "E:\XL" [COLOR="SeaGreen"]' A adapter[/COLOR]
scan Répertoire
[COLOR="RoyalBlue"]End Sub[/COLOR]
[COLOR="RoyalBlue"]
Sub scan(Répertoire)[/COLOR]
Dim Fso As Scripting.FileSystemObject
Dim RépSource As Scripting.Folder
Dim ValCherchée
Dim SousRép As Scripting.Folder
Dim Fichier As Scripting.File
ValCherchée = [COLOR="Red"]2280.26[/COLOR] [COLOR="SeaGreen"]'A adapter[/COLOR]
Set Fso = CreateObject("Scripting.FileSystemObject")
Set RépSource = Fso.GetFolder(Répertoire)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
For Each Fichier In RépSource.Files
If Right$(Fichier, 4) = ".xls" Then [COLOR="SeaGreen"]' Recherche des fichiers .xls[/COLOR]
Workbooks.Open Filename:=Répertoire & "\" & Fichier.Name [COLOR="SeaGreen"]'ouverture du fichier[/COLOR]
For t = 1 To ActiveWorkbook.Sheets.Count [COLOR="SeaGreen"]' Scan ds chaque onglet[/COLOR]
If Not ActiveWorkbook.Sheets(t).Cells.Find(ValCherchée) Is Nothing Then
ActiveWorkbook.Sheets(t).Cells.Find(ValCherchée).Select
Application.ScreenUpdating = True
MsgBox "Trouvé!"
Exit Sub
End If
Next
ActiveWorkbook.Close False
End If
Next Fichier
[COLOR="SeaGreen"]'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.[/COLOR]
For Each SousRép In RépSource.subfolders
scan SousRép.Path
Next SousRép
[COLOR="RoyalBlue"]End Sub[/COLOR]