Microsoft 365 Effectué une recherche dans plusieurs fichiers

let
// ici il faut changer le chemin du dossier avec celui qui est sur ton PC
    Source = Folder.Files("C:\Users\STAPLE\Downloads\test recherche"),
    #"Lignes filtrées" = Table.SelectRows(Source, each ([Extension] = ".xls")),
    #"Fichiers masqués filtrés1" = Table.SelectRows(#"Lignes filtrées", each [Attributes]?[Hidden]? <> true),
    #"Appeler une fonction personnalisée1" = Table.AddColumn(#"Fichiers masqués filtrés1", "Transformer le fichier", each #"Transformer le fichier"([Content])),
    #"Colonnes renommées1" = Table.RenameColumns(#"Appeler une fonction personnalisée1", {"Name", "Source.Name"}),
    #"Autres colonnes supprimées1" = Table.SelectColumns(#"Colonnes renommées1", {"Source.Name", "Transformer le fichier"}),
    #"Colonne de tables développée1" = Table.ExpandTableColumn(#"Autres colonnes supprimées1", "Transformer le fichier", Table.ColumnNames(#"Transformer le fichier"(#"Exemple de fichier"))),
    #"Type modifié" = Table.TransformColumnTypes(#"Colonne de tables développée1",{{"Source.Name", type text}, {"date de commande", type date}, {"date de livraison", type date}, {"numero de palette ", type text}, {"ref article", type text}, {"n° de serie ", type text}, {"Column6", type text}}),
    #"Colonnes supprimées" = Table.RemoveColumns(#"Type modifié",{"Column6"})
in
    #"Colonnes supprimées"

Private Sub CommandButton1_Click()
ActiveSheet.ListObjects("test_recherche").Range.AutoFilter _
Field:=4, Criteria1:="=*" & [F2] & "*", Operator:=xlAnd
End Sub

Sub Recherche()
Dim t, cible$, chemin$, fso As Object, ncol%, lig&, sf As Object, f As Object, nf%, wb As Workbook, plage As Range, i&, j%
t = Timer
cible = "*" & [B1].Text & "*"
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
ncol = 5 'nombre de colonnes à étudier
Application.ScreenUpdating = False
With Sheets("Feuil1").[A3].CurrentRegion 'nom de la feuille à adapter
    .Offset(1).Delete xlUp 'RAZ
    lig = 2
    For Each sf In fso.Getfolder(chemin).Subfolders
    For Each f In sf.Files
        nf = nf + 1
        Set wb = Workbooks.Open(chemin & sf.Name & "\" & f.Name) 'ouverture du fichier
        Set plage = wb.Sheets(1).Range("B3").CurrentRegion.Resize(, ncol) 'adapter éventuellement
        For i = 2 To plage.Rows.Count
            For j = 1 To ncol
                If plage(i, j).Text Like cible Then
                    .Cells(lig, 1) = sf.Name
                    .Cells(lig, 2) = f.Name
                    .Cells(lig, 3).Resize(, ncol) = plage.Rows(i).Value
                    lig = lig + 1
                    Exit For
                End If
        Next j, i
        wb.Close False 'fermeture du fichier
    Next f, sf
    .Offset(, 1).EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
Application.ScreenUpdating = True
MsgBox nf & " fichuers étudiés et " & lig - 2 & " ligne" & IIf(lig > 3, "s", "") & " copiée" & IIf(lig > 3, "s", "") & " en " & Format(Timer - t, "0.00 \sec")
End Sub

Sub Dossier()
Dim chemin$, fso As Object, sf As Object, liste$
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each sf In fso.Getfolder(chemin).Subfolders
    liste = liste & "," & sf.Name
Next sf
With [B1]
    .Validation.Delete
    .Validation.Add xlValidateList, Formula1:=Mid(liste, 2)
    .Select
    CreateObject("WScript.Shell").SendKeys "%{DOWN}"
End With
End Sub

Sub Recherche()
Dim sf$, cible$, chemin$, fso As Object, ncol%, lig&, f As Object, wb As Workbook, plage As Range, i&, j%
sf = [B1]
If sf = "" Then Dossier: Exit Sub
cible = "*" & [D1].Text & "*"
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
ncol = 5 'nombre de colonnes à étudier
Application.ScreenUpdating = False
With Sheets("Feuil1").[A3].CurrentRegion 'nom de la feuille à adapter
    .Offset(1).Delete xlUp 'RAZ
    lig = 2
    For Each f In fso.Getfolder(chemin & sf).Files
        Set wb = Workbooks.Open(chemin & sf & "\" & f.Name) 'ouverture du fichier
        Set plage = wb.Sheets(1).Range("B3").CurrentRegion.Resize(, ncol) 'adapter éventuellement
        For i = 2 To plage.Rows.Count
            For j = 1 To ncol
                If plage(i, j).Text Like cible Then
                    .Cells(lig, 1) = f.Name
                    .Cells(lig, 2).Resize(, ncol) = plage.Rows(i).Value
                    lig = lig + 1
                    Exit For
                End If
        Next j, i
        wb.Close False 'fermeture du fichier
    Next f
    .Offset(, 1).EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

Sub Recherche()
Dim cible$, fso As Object, ncol%, dossier As FileDialog, sf$, lig&, f As Object, wb As Workbook, plage As Range, i&, j%
cible = "*" & [F1].Text & "*"
Set fso = CreateObject("Scripting.FileSystemObject")
ncol = 5 'nombre de colonnes à étudier
ChDir ThisWorkbook.Path 'dossier initial
Set dossier = Application.FileDialog(msoFileDialogFolderPicker)
If dossier.Show = False Then [B1] = "": Exit Sub
sf = dossier.SelectedItems(1) & "\"
[B1] = sf
Application.ScreenUpdating = False
With Sheets("Feuil1").[A3].CurrentRegion 'nom de la feuille à adapter
    .Offset(1).Delete xlUp 'RAZ
    lig = 2
    For Each f In fso.Getfolder(sf).Files
        Set wb = Workbooks.Open(sf & f.Name) 'ouverture du fichier
        Set plage = wb.Sheets(1).Range("B3").CurrentRegion.Resize(, ncol) 'adapter éventuellement
        For i = 2 To plage.Rows.Count
            For j = 1 To ncol
                If plage(i, j).Text Like cible Then
                    .Cells(lig, 1) = f.Name
                    .Cells(lig, 2).Resize(, ncol) = plage.Rows(i).Value
                    lig = lig + 1
                    Exit For
                End If
        Next j, i
        wb.Close False 'fermeture du fichier
    Next f
    .EntireColumn.AutoFit 'ajustement largeurs
    If .Columns(5).ColumnWidth < 13 Then .Columns(5).ColumnWidth = 13
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

.Cells(lig, 1) = f.Name

.Hyperlinks.Add .Cells(lig, 1), sf & f.Name, TextToDisplay:=f.Name 'lien hypertecte