Microsoft 365 Rechercher dans plusieurs fichiers

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible, chemin$, x$, fichier, lig&, fich, wb As Workbook, w As Worksheet, tablo, ub%, i&, j%
cible = [B1].Value 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
x = Format(Date, " yyyy mm dd") & ".xlsx" 'à adapter au besoin
fichier = Array("isiTel_lionel_fichier1" & x, "isiTel_lionel_fichier2" & x, "isiTel_lionel_fichier3" & x) 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("D2:F" & Rows.Count).ClearContents 'RAZ
lig = 2
For Each fich In fichier
    If Dir(chemin & fich) = "" Then MsgBox "créez le fichier '" & fich & "' !", 48: Exit Sub
    Set wb = Workbooks.Open(chemin & fich)
    For Each w In wb.Worksheets
        tablo = w.Range("A1:A2", w.UsedRange) 'matrice, plus rapide, au moins 2 éléments
        ub = UBound(tablo, 2) 'nombre de colonnes
        For i = 1 To UBound(tablo)
            For j = 1 To ub
                If tablo(i, j) = cible Then
                    Cells(lig, 4) = wb.Name
                    Cells(lig, 5) = w.Name
                    Cells(lig, 6) = w.Cells(i, j).Address(0, 0)
                    lig = lig + 1
                End If
    Next j, i, w
    wb.Close 'ferme le fichier
Next fich
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim chemin$, wb As Workbook, lig&
chemin = ThisWorkbook.Path & "\" 'à adapter
lig = Target.Row
On Error Resume Next
Set wb = Workbooks.Open(chemin & Cells(lig, 4))
Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
End Sub