Sub Recherche()
Dim chemin$, fichier$, d As Object, w As Worksheet, tablo, e, a, b(), i&, j%
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
While fichier <> ""
If fichier <> ThisWorkbook.Name Then
With Workbooks.Open(chemin & fichier)
For Each w In .Worksheets
tablo = w.UsedRange
If Not IsArray(tablo) Then tablo = w.UsedRange.Resize(2)
For Each e In tablo
If e Like "##############" Then d(e & Chr(1) & .Name) = ""
Next e, w
.Close
End With
End If
fichier = Dir 'fichier suivant
Wend
'---restitution et mise en forme---
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Range("A2:B" & Rows.Count).ClearContents 'RAZ
If d.Count = 0 Then Exit Sub
a = d.keys
ReDim b(UBound(a), 1) 'base 0
For i = 0 To UBound(a)
j = InStr(a(i), Chr(1))
b(i, 0) = Left(a(i), j - 1)
b(i, 1) = Mid(a(i), j + 1)
Next
[A:A].NumberFormat = String(14, "0")
[A2].Resize(i, 2) = b
[A2].Resize(i, 2).Sort [A2], xlAscending, [B2], , xlAscending, Header:=xlNo 'tri sur 2 colonnes
Columns("A:B").AutoFit 'ajustement largeur
With ActiveSheet.UsedRange: End With 'actualise la barre de défilement verticale
End Sub