Recherche occurence dans plusieurs fichiers excell

Sub Recherche()
Dim chemin$, fichier$, d1 As Object, d2 As Object, d3 As Object, w As Worksheet, tablo, nom$, i&, j&, x$
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = 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.Resize(, 4)
                nom = "#" & .Name & "#"
                For i = 1 To UBound(tablo)
                    x = CStr(tablo(i, 2))
                    If x Like "##############" Then
                        If InStr("#" & d1(x) & "#", nom) = 0 Then
                            d1(x) = IIf(d1(x) = "", "", d1(x) & "#") & .Name
                            For j = i To 1 Step -1
                                If IsDate(Right(tablo(j, 1), 8)) Then
                                    d2(x) = IIf(d2(x) = "", "", d2(x) & "#") & Right(tablo(j, 1), 8)
                                    Exit For
                                End If
                            Next j
                            d3(x) = IIf(d3(x) = "", "", d3(x) & "#") & tablo(i, 4) 'commentaire en colonne D
                        End If
                    End If
            Next i, w
            .Close
        End With
    End If
    fichier = Dir 'fichier suivant
Wend
'---restitution---
tablo = ActiveSheet.UsedRange.Resize(, 4)
For i = 2 To UBound(tablo)
    tablo(i, 2) = d1(CStr(tablo(i, 1)))
    If d2.exists(CStr(tablo(i, 1))) Then tablo(i, 3) = CDate(d2(CStr(tablo(i, 1)))) Else tablo(i, 3) = ""
    tablo(i, 4) = d3(CStr(tablo(i, 1)))
Next i
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
[A1].Resize(UBound(tablo), 4) = tablo
Columns.AutoFit 'ajustement largeur
End Sub