XL 2016 Recherche de caractères dans plusieurs fichiers fermer d'un dossier

[treza88]

Bonjour a tous,

je cherche comment faire une recherche de caractères dans une dizaine de cellule compris dans une ligne du premier onglet dans plusieurs fichiers fermer d'un même dossier.
je m'y perds a regarder sur internet.
Je pense que c'est possible, mais je ne sais pas comment m'y prendre.
j'ai vu des choses avec RECHERCHEH ou FIND, mais je suis incapable de me faire une idée sur la meilleur solution.
Pouvez vous me dire ce qui pourrait être une bonne solution pour faire un projet bien ciblé des le départ.
Si vous avez des exemples c'est encore plus cool.

Si toute fois je ne suis pas clair dans la description de mon besoin , n'hésitez pas.

Merci d'avance

 

[treza88]

Désolé je comptais adapter a mon besoin réel comme je le fait en vba.
Je recrée, je modifie et je complète ce qui me permet de comprendre le code qui m'est présenté, et ça me permet de progresser
Et j'aime bien comprendre comment ça fonctionne pour pouvoir le réutiliser.
Sinon ma plage de cellule dans mes fichiers originaux et de "I7" à "W7"

 

[job75]

Voyez les fichiers joints et cette macro dans la feuille de restitution des résultats :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim chemin$, fichier$, feuille$, lig&, ncol%, x$, resu(), fich$, form$, i%, y$, n&
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls*")
feuille = "Feuil1" 'nom de la feuille où l'on cherche
lig = 3 'n° de ligne où l'on recherche
ncol = 20 'nombre de colonnes où l'on recherche
x = UCase([C2].Text) 'caractères recherchés en majuscules
If x <> "" Then
    ReDim resu(1 To Rows.Count, 1 To 3)
    While fichier <> ""
        If fichier <> ThisWorkbook.Name Then
            fich = Replace(fichier, "'", "''") 'en cas d'apostrophe dans le nom
            form = "'" & chemin & "[" & fich & "]" & feuille & "'!R" & lig & "C"
            For i = 1 To ncol
                y = ExecuteExcel4Macro(form & i)
                If InStr(UCase(y), x) Then
                    n = n + 1
                    resu(n, 1) = fichier
                    resu(n, 2) = Cells(lig, i).Address(0, 0)
                    resu(n, 3) = y
                End If
            Next
        End If
        fichier = Dir
    Wend
End If
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [E3] '1ère cellule de destination, à adapter
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Téléchargez les fichiers dans le même dossier.

 

[R@chid]

Re,
tu vas suivre les étapes que j'ai fait jusqu'à la dernière étapes lorsque j'ai fait le filtre, j'ai filtré sur les mots contenant "ari" après tu vas sur l'éditeur avancé et tu vas remplacer "ari" par MotCherche qui provient du fichier Excel.

let
Source = Folder.Files("C:\Users\M. Rachid\Desktop\treza88"),
#"Texte en minuscules" = Table.TransformColumns(Source,{{"Extension", Text.Lower, type text}}),
#"Lignes filtrées" = Table.SelectRows(#"Texte en minuscules", each [Extension] = ".xlsm"),
#"Personnalisée ajoutée" = Table.AddColumn(#"Lignes filtrées", "Personnalisé", each Excel.Workbook([Content])),
#"Autres colonnes supprimées" = Table.SelectColumns(#"Personnalisée ajoutée",{"Name", "Personnalisé"}),
#"Personnalisé développé" = Table.ExpandTableColumn(#"Autres colonnes supprimées", "Personnalisé", {"Data"}, {"Data"}),
#"Data développé" = Table.ExpandTableColumn(#"Personnalisé développé", "Data", {"Column1", "Column2", "Column3", "Column4"}, {"Column1", "Column2", "Column3", "Column4"}),
#"Texte extrait avant le délimiteur" = Table.TransformColumns(#"Data développé", {{"Name", each Text.BeforeDelimiter(_, "."), type text}}),
#"Supprimer le tableau croisé dynamique des autres colonnes" = Table.UnpivotOtherColumns(#"Texte extrait avant le délimiteur", {"Name"}, "Attribut", "Valeur"),
#"Colonnes supprimées" = Table.RemoveColumns(#"Supprimer le tableau croisé dynamique des autres colonnes",{"Attribut"}),
#"Colonnes renommées" = Table.RenameColumns(#"Colonnes supprimées",{{"Valeur", "Données"}, {"Name", "Fichier"}}),
#"Lignes filtrées1" = Table.SelectRows(#"Colonnes renommées", each Text.Contains([Données], MotCherche))
in
#"Lignes filtrées1"

 

[job75]

Sinon ma plage de cellule dans mes fichiers originaux et de "I7" à "W7"

Alors dans ma macro faites lig = 7 et remplacez :

For i = 1 To ncol

par :

For i = 9 To 23

 

[treza88]

Merci R@chid pour tes précisions, mais j'ai du mal a utiliser Power Query, j'ai bien trouvé MotCherche, mais je ne comprend pas comment sélectionner la plage de cellule recherché.
Mais c'est peut être la philosophie des requête que je ne comprend pas, désolé.
Sinon job75 je suis plus a l'aise avec ton code, et j'ai bien compris tes explications, par contre si je voulais importer les onglets comportant ces données comment devrais procédé?

 

[job75]

D'après ce que j'ai compris il ne s'agit pas d'importer des onglets mais des valeurs !

Si vous voulez créer des onglets il faut ouvrir les fichiers et copier les feuille, c'est autre chose.

 

[treza88]

Ok merci job75, mais une fois que l'on connais les fichier qui ont les valeurs recherché.
Ca m'intéresse d'importer le premier onglet de ces fichiers, même s'ils faut ouvrir les fichiers.
L'avantage avec ton code c'est que l'on connais déjà les fichiers a ouvrir.
Si j'ai 40 fichiers cela m'en fait peut être que 4 à ouvrir pour récupérer le premier onglet.

 

[treza88]

Voici ce que j'ai fait peux tu me dire ce que tu en pense.
A utiliser avec les deux autres fichiers

 

[job75]

Pour importer les onglets il faut compléter la fin de la macro, voyez ce fichier (2) :

'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
If FilterMode Then ShowAllData 'si la feuille est filtrée
Set dest = [E3] '1ère cellule de destination, à adapter
If n Then dest.Resize(n, 3) = resu
dest.Offset(n).Resize(Rows.Count - n - dest.Row + 1, 3).ClearContents 'RAZ en dessous
'---création des onglets---
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
    If i <> Me.Index Then Sheets(i).Delete 'supprime les feuilles
Next
For i = 1 To n
    If dest(i) <> dest(i - 1) Then
        With Workbooks.Open(chemin & dest(i)) 'ouverture du fichier
            .Sheets(feuille).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            ActiveSheet.Name = Left(.Name, 31)
            .Close 'fermeture du fichier
        End With
    End If
Next
Me.Activate
Application.EnableEvents = True 'réactive les évènements*
End Sub