Microsoft 365 Recherche dans fichier excel dans un répertoire

Option Explicit
Const Feuil1$ = "DOVE"
Const Feuil2$ = "Communication"
Const col1% = 1 'colonne A
Const col2% = 6 'colonne F
Const crit1$ = "Véhicule :"
Const crit2$ = "Vin :"
Const crit3$ = "Battery Identification Number :"
Const crit4$ = "<- 62 F0 29*"
Dim fichier$, lig&, trouve&

Sub Recherche()
Dim t, chemin$, fso As Object, fich As Object, form$, compte
t = Timer
chemin = ThisWorkbook.Path & "\REPERTOIRE_FICHIERS" & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
lig = 3
Application.ScreenUpdating = True
Rows(lig & ":" & Rows.Count).ClearContents 'RAZ
For Each fich In fso.GetFolder(chemin).Files
    fichier = fich.Name
    If Right(fichier, 5) = ".xlsx" Then
        compte = compte + 1
        form = "'" & chemin & "[" & fichier & "]" & Feuil1 & "'!"
        Formule form, col1, crit1, lig
        Formule form, col1, crit2, lig
        Formule form, col1, crit3, lig

        form = "'" & chemin & "[" & fichier & "]" & Feuil2 & "'!"
        Formule form, col1, crit4, lig

        If trouve = 1 Then lig = lig + 1
        trouve = 0
    End If
Next
MsgBox Timer - t
End Sub

Sub Formule(form$, col%, crit$, lig&)
Dim f$, v
f = "MATCH(""" & crit & """," & form & "C" & col & ",0)"
v = ExecuteExcel4Macro(f)
If IsNumeric(v) Then
    trouve = 1
    Cells(lig, 1) = fichier 'retourne le nom du fichier
    If crit = crit1 Then Cells(lig, 2) = ExecuteExcel4Macro(form & "R" & v & "C" & col + 1) 'retourne la valeur du Véhicule
    If crit = crit2 Then Cells(lig, 3) = ExecuteExcel4Macro(form & "R" & v & "C" & col + 1) 'retourne la valeur du Vin
    If crit = crit3 Then Cells(lig, 4) = ExecuteExcel4Macro(form & "R" & v & "C" & col + 1) 'retourne la valeur du BIN

    If crit = crit4 Then Cells(lig, 5) = ExecuteExcel4Macro(form & "R" & v & "C" & col) 'retourne la valeur de la trame 62 F0 29
End If
End Sub