XL 2016 Lire dans classeurs fermés et copie si trouve

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

Me voici devant un nouveau souci de codification que je ne sais vraiment pas faire.
Malgré mes recherches j'ai pas trouvé de solution sur le site et sur le net.
J'ai tenté beaucoup de codes que j'ai tenté d'adapter sans succès.

Je ne tourne "naturellement" LOL vers nos ténors toujours si efficaces pour solliciter de l'aide.

Voici mon problème :
ici, pour l'exemple, j'ai créé 3 classeurs (si solution il y a, il me sera facile de modifier pour inclure tous les classeurs dans le code)

Je souhaiterai qu'à partir du fichier "Import_Valeur_Cherchée" onglet "Résultat" :

1 - je clique sur le bouton "recherche",
2 - je colle le N° qui appelle,
3 - le code va lire tous les classeurs (fermés) et s'il trouve, il me copie la ligne (où les lignes si plusieurs) dans ce classeur dans l'onglet "Résultat"

Pour tests codes, je joins les classeurs :
Import_Valeur_Cherchée (qui contient dans l'onglet "Ce que je voudrais faire", l'explication détaillée de mon besoin)
Classeur_1 - Classeur_2 - Classeur_3
+ classeur qui contient d’excellents codes de SilkyRoad qui me semblent proches de mon besoin.

En espérant que vous pourrez, une nouvelle fois m'aider et vous en remerciant,
Je vous souhaite à toutes et à tous une très belle journée.
Amicalement,
Lionel,
 

Pièces jointes

  • Classeur_1.xlsm
    11.5 KB · Affichages: 12
  • Classeur_2.xlsm
    11.5 KB · Affichages: 11
  • Classeur_3.xlsm
    11.5 KB · Affichages: 9
  • SilkyRoad.xlsm
    22.4 KB · Affichages: 16
  • Import_Valeur_Cherchée.xlsm
    25.4 KB · Affichages: 15
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Lionel, le fil,

Bah depuis le début j'avais écrit chemin = ThisWorkbook.Path & "/" alors qu'il faut chemin = ThisWorkbook.Path & "\"

Cela n'a pas d'importance (du moins chez moi) mais je viens de corriger toutes mes macros et fichiers.

A+
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonsoir Gérard, le forum,

J'ai avancé sur le sujet LOL.
ça fonctionne avec les fichiers anonymisés, c'est déjà une avancée mais je ne sais pas pourquoi :mad:

Ce qui est curieux, c'est que tous les fichiers sont identiques en structures;
Et pour mes fichiers de travail ça ne fonctionne encore pas alors que les fichiers anonymisés en sont la copie :mad:

Je continue. j'espère trouver et je te dirai :)
Lionel,
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour Gérard, le Forum :)
J'ai continué à chercher hier au soir mais sans trouver :mad:
Plusieurs questions ne sont apparu :
Dans les classeurs de recherche = feuille "Rendez"Vous" (feuille "Données" pour les tests)

les classeurs de recherches ont plusieurs feuilles,

feuille RendezVous :
les colonnes A à H sont masquées (largeur O),
Elles sont protégées avec mots de passe,

Incidence sur l'exécution du code ?

Bonne journée à toutes et à tous,
Lionel :)
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour Gérard, le forum,

@Gérard

Je m'en serait voulu que tout ton travail ne serve à rien.
J'ai continué mes recherches, essayé de comprendre, vérifié mes fichiers dans tous les sens ...
et enfin, ce matin .....
Euréka !!! miracle !!! ça marche et je ne sais pas pkoi ... Mais ça marche :)
J'ai fait une vingtaine de tests avec mes fichiers de travail.
Je vais donc surveiller ça de près pour voir ce qui pourrait se passer si ça ne fonctionnait pas à nouveau.

Je confirme que chez moi, le temps d'exécution est bcp plus rapide que le code du poste 2
en moyenne de 3 à 10 secondes au lieu de 30 à + d'une minute;

A l'instant, il me reste un souci :
Le code cherche dans tous les fichiers xlsm contenus dans le dossier.
Dans ce dossier, j'ai d'autres fichiers xlsm que je ne peux pas déplacer.
est-il possible d'indiquer dans le code les noms des fichiers dans lesquels la recherche est à faire ?

Bonne fin de journée à toutes et à tous,
Lionel :)
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Lionel,
et enfin, ce matin .....
Euréka !!! miracle !!! ça marche et je ne sais pas pkoi ... Mais ça marche :)
C'est bien connu, Excel est un grand sentimental qui se laisse attendrir quand on lui parle gentiment :rolleyes:
est-il possible d'indiquer dans le code les noms des fichiers dans lesquels la recherche est à faire ?
Normalement on ne met dans le même dossier que les fichiers que l'on veut traiter mais bon teste ce fichier (3) :
VB:
Sub Recherche()
Dim tel$, chemin$, a, resu(), aux As Worksheet, fichier, f$, h&, tablo, i&, n&, j%
tel = InputBox("Entrez le numéro de téléphone recherché :")
If tel = "" Then Exit Sub
chemin = ThisWorkbook.Path & "\"
a = Array("Classeur_1.xlsm", "Classeur_2.xlsm", "Classeur_3.xlsm") 'liste à adapter
ReDim resu(1 To Rows.Count, 1 To 27)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set aux = Worksheets.Add 'feuille auxiliaire
For Each fichier In a
    f = "'" & chemin & "[" & fichier & "]Donnees'!"
    h = ExecuteExcel4Macro("MATCH(9^99," & f & "C14)")
    aux.[A1].Resize(h, 27).FormulaArray = "=" & f & "R1C9:R" & h & "C35" 'formule de liaison matricielle
    tablo = aux.[A1].Resize(h, 27) 'matrice, plus rapide
    For i = 1 To h
        If CStr(tablo(i, 6)) = tel Or CStr(tablo(i, 7)) = tel Then
            n = n + 1
            For j = 1 To 27
                If tablo(i, j) <> 0 Then resu(n, j) = tablo(i, j)
            Next j
        End If
    Next i
    aux.Cells.ClearContents
Next fichier
aux.Delete
'---restitution---
With Feuil1.[I2] 'cellule à adapter
    If n Then .Resize(n, 27) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 27).ClearContents 'RAZ en dessous
    .Parent.Parent.Activate
End With
End Sub
A+
 

Pièces jointes

  • Import_Valeur_Cherchée(3).xlsm
    29.2 KB · Affichages: 7
  • Classeur_1.xlsm
    16.8 KB · Affichages: 5
  • Classeur_2.xlsm
    16.8 KB · Affichages: 5
  • Classeur_3.xlsm
    16.8 KB · Affichages: 7

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re-Gérard,

Je copie le dossier intégral du dossier qui contient "Import_Valeur_Cherchée_51colonnes"
et les classeurs de recherche ( je re-teste et le code recherche fonctionne (sur l'instant LOL))
- J'y ajoute d'autres classeurs xlsm
- Je copie ton nouveau code et j'inclus les noms des classeurs de recherche,
- Je remplace 27 par 51 et 34 par 59
- je remplace données par RendezVous

Je teste ... transpiration intense et il fait plus de 40° en Tunisie LOL .... et ... et ..... ça marche :)
Super et j'espère que ça va durer LOL.

Le plus grand des mercis ne sera pas suffisant pour m'exprimer :)
Lionel,
 

Discussions similaires