Microsoft 365 Rechercher dans plusieurs fichiers

Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous :)

En voici une bonne pour ce début de semaine lol 🙃

Evidemment, je ne sais pas coder pour résoudre mon besoin !
Alors, je sollicite à nouveau nos chers ténors :

Voici le contexte de mon besoin :
NOUS TRAVAILLONS AVEC 3 FICHIERS ouverts généralement en même temps.

Les Professionnels que nous appelons sont difficiles à joindre.
Nous avons souvent des répondeurs et nous laissons un message.

Quand un Pro nous rappelle, NOUS DE DECROCHONS PAS.
Avant de rappeler nous vérifions à partir de quel fichier on a appelé pour savoir où nous en sommes avec le Pro.

Pour le rappeler il faut faire vite avant que le Pro ne soit à nouveau occupé.
Pour cela, il nous faut trouver très rapidement à partir de quel fichier nous avons appelé.

Nos 3 fichiers sont identiques et nous commençons toujours nos recherches par la feuille Appels,
Le besoin
Partant du principe que nos 3 fichiers sont généralement ouverts en même temps (mais ce n'est pas toujours le cas) :
Est-il possible si la recherche ne trouve rien dans la feuille active (Appels) du fichier actif que la recherche :
si pas trouvé que la recherche propose de chercher dans le fichier suivant (ouvert) ? :
1647274113301.png

Les noms des fichiers sont toujours les mêmes sauf la date qui change.
isiTel_lionel_fichier1 2022 03 14
isiTel_lionel_fichier2 2022 03 14
isiTel_lionel_fichier3 2022 03 14

Auriez-vous le bon code ?

Un grand merci par avance :)
Je continue à tâtonner .. et je joins un petit fichier test qui contient le code de la recherche.
Amicalement,
lionel :)
 

Pièces jointes

  • Recherche_classeurs.xlsm
    33.5 KB · Affichages: 23
Dernière édition:
Solution
job75
Bonjour Lionel, le forum,

Je disais que ce fil était sans fin !!!

Pour traiter plusieurs feuilles il suffit d'ajouter une boucle sur les noms des feuilles :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille, plage As Range, lig&, i%, col As Range, x$, n&
cible = Right([B1], 9) 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = Array("Appels", "Sextant", "Dr House") 'liste des feuilles où l'on recherche
Set plage = [D1:G10000] 'référence de la plage de recherche à adapter
lig = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
While fichier <> ""...
Trier par date Trier par votes
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour job75, Bonjour Jean-Marie, Bonjour Marcel, le Forum,
Bon WE à toutes et à tous :)

@Gérard : Dernière version #post 69 au top top top super génial !
Rien à dire c'est du grand art.
Et moi qui ai besoin de rapidité, c'est quasi instantané .. vraiment superbe !!!

Enfin si, j'ai un autre p'tit' besoin :
Par exemple, aujourd'hui j'ai préparé mes fichiers pour le travail de lundi ils sont tous maintenant nommés : isiTel_lionel_ExpRealty 2022 03 21 (leurs noms et la date de lundi) et il peut y avoir également des fichiers pour lesquels je ne travaille pas "aujourd'hui"

Le code recherche cherche la date d'aujourd'hui soit le 2022 03 19 et me dit qu'il est introuvable.
C'est pas trop gênant mais je dois changer la date de tous les fichiers et, en fait j'en ai actuellement 5.
Est-il possible que le code ne tienne pas compte de la date ?

Idéalement en se basant uniquement sur "isiTel" ?
Car j'ai aussi : isiTel_Charlotte Dr House 2022 03 21 et isiTel_Stephanie MeilleurConseil 2022 03 21 et j'en aurai d'autres : seul isiTel au début du nom ne change jamais.
mais je ne sais pas le faire :mad:

Si pas possible = pas grave.

Merci Gérard pour ton aide si précieuse.
Amicalement,
lionel ;)
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Lionel, le forum,

Normalement quand on modifie complètement la demande initiale on doit créer une nouvelle discussion.

Sinon le fil est sans fin !!!

Mais bon tu peux tester ce fichier (4) :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille$, col$, lig&, x$, i As Variant
cible = [B1] 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = "Appels"
col = "C6" 'colonne F en notation R1C1
lig = 2
While fichier <> ""
    x = chemin & "[" & fichier & "]" & feuille & "'!" & col & ",0)"
    i = ExecuteExcel4Macro("MATCH(" & cible & ",'" & x) 'recherche un nombre
    If IsError(i) Then i = ExecuteExcel4Macro("MATCH(""" & cible & """,'" & x) 'recherche un texte
    If IsNumeric(i) Then
        Cells(lig, 4) = fichier
        Cells(lig, 5) = feuille
        Cells(lig, 6) = "F" & i
        lig = lig + 1
    End If
    fichier = Dir 'fichier suivant
Wend
Range("D" & lig & ":F" & Rows.Count).ClearContents 'RAZ
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(CStr(Cells(lig, 4)))
If wb Is Nothing Then
    Set wb = Workbooks.Open(chemin & Cells(lig, 4))
    Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
End If
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48
End Sub
A+
 

Pièces jointes

  • Recherche(4).xlsm
    22.2 KB · Affichages: 5
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
job75 à dit:
Bonjour Lionel, le forum,

Normalement quand on modifie complètement la demande initiale on doit créer une nouvelle discussion.

Sinon le fil est sans fin !!!

Mais bon tu peux tester ce fichier (4) :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille$, col$, lig&, x$, i As Variant
cible = [B1] 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = "Appels"
col = "C6" 'colonne F en notation R1C1
lig = 2
While fichier <> ""
    x = chemin & "[" & fichier & "]" & feuille & "'!" & col & ",0)"
    i = ExecuteExcel4Macro("MATCH(" & cible & ",'" & x) 'recherche un nombre
    If IsError(i) Then i = ExecuteExcel4Macro("MATCH(""" & cible & """,'" & x) 'recherche un texte
    If IsNumeric(i) Then
        Cells(lig, 4) = fichier
        Cells(lig, 5) = feuille
        Cells(lig, 6) = "F" & i
        lig = lig + 1
    End If
    fichier = Dir 'fichier suivant
Wend
Range("D" & lig & ":F" & Rows.Count).ClearContents 'RAZ
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(CStr(Cells(lig, 4)))
If wb Is Nothing Then
    Set wb = Workbooks.Open(chemin & Cells(lig, 4))
    Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
End If
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48
End Sub
A+
Cliquez pour agrandir...
Bonjour Gérard,
C'est vrai, j'aurais du le faire mais c'est quand même le même sujet "source".

Je ne sais plus comment te dire merci depuis le temps que tu m'aides :)
En attendant que je trouve : M E R C I Gérard :)
lionel,
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Usine à gaz à dit:
Bonjour Gérard,
C'est vrai, j'aurais du le faire mais c'est quand même le même sujet "source".

Je ne sais plus comment te dire merci depuis le temps que tu m'aides :)
En attendant que je trouve : M E R C I Gérard :)
lionel,
Cliquez pour agrandir...
Re-Gérard :)
Cette fois-ci c'est trop top.
Et super car facilement adaptable pour l'utiliser pour d'autres types de fichiers.
Encore MERCI : c'est superbe,
lionel :)
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour Lionel
Bonjour le fil ,le Forum
@lionel :
tu dis :
Par exemple, aujourd'hui j'ai préparé mes fichiers pour le travail de lundi ils sont tous maintenant nommés : isiTel_lionel_ExpRealty 2022 03 21 (leurs noms et la date de lundi) et il peut y avoir également des fichiers pour lesquels je ne travaille pas "aujourd'hui"
Cliquez pour agrandir...
quand tu recherches via la structure "isiTel*.xlsb"
il n'y a pas de risque que tu fasses référence à beaucoup de fichiers ayant cette structure ,
ou alors tu supprimes les fichiers antérieurs au fur et à mesure ? pas plus d'un jour présent dans ex Mardi les fichiers du Lundi ne sont plus présents ,c'est ça?
merci par avance
Bonne Journée
Jean marie
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
J'ai juste un peu modifier ce code (Arf, tu ne connais maintenant lol) :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'ActiveSheet.Unprotect Password:=""
Dim wb As Workbook, lig&
lig = Target.Row
On Error Resume Next
Set wb = Workbooks(CStr(Cells(lig, 4)))
Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
    ActiveWindow.ScrollRow = Selection.Row
ActiveCell.RowHeight = 55 'si filtrée remise à hauteur pour la voir
ActiveCell.Offset(0, -5).Select
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Ouvrez le fichier '" & Cells(lig, 4) & "' !", 48
'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
ça me permet d'aller directement sur la ligne du numéro :)
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re
Lionel !
Une question n'y a-t-il pas un problème de traiter l'absence de Fichier soit :
VB: 
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Ouvrez le fichier '" &
Après avoir traité les données .
Code: 
On Error Resume Next
Set wb = Workbooks(CStr(Cells(lig, 4)))
Application.Goto wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
tu me diras le :
Code: 
On Error Resume Next
fait le Boulot Lol
et alors le
Code: 
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Ouvrez le fichier '"
n'a plus lieu d'être
Ou alors une fois encore j'ai pas compris ! Lol
Bonne journée
Jean marie
 
Vote positif 0 Vote négatif

Discussions similaires

Usine à gaz
  • Résolu(e)
XL 2021 Rechercher dans plusieurs fichiers
2
Réponses
18
Affichages
799
Usine à gaz
Usine à gaz
A
  • Question
XL 2019 rechercher un nom dans plusieurs fichiers
Réponses
4
Affichages
262
sylvanu
sylvanu
M
  • Question
Microsoft 365 Pb de formules qui se modifient dans des cellules verrouillées
Réponses
14
Affichages
271
TooFatBoy
TooFatBoy
ArnaudSi
  • Question
XL pour MAC Besoin d'aide pour calculer automatiquement un jour de livraison dans Excel
Réponses
10
Affichages
328
ArnaudSi
ArnaudSi
S
  • Résolu(e)
XL 2019 fichier suivi de chantier
Réponses
8
Affichages
810
saimone
S
L
  • Résolu(e)
Microsoft 365 Création d'un fichier avec plusieurs feuilles ou des liaisons?
2
Réponses
29
Affichages
1 K
laurabachau
L
Darkopsix
  • Résolu(e)
XL 2021 Récupérer des données de fichiers dons les noms sont renseignés dans des cellules
Réponses
2
Affichages
431
Darkopsix
Darkopsix
P
  • Question
Microsoft 365 Rechercher un fichier dans dossier
Réponses
14
Affichages
708
pelerin65
P
M
  • Question
Microsoft 365 aide sur macro pour une asso
2
Réponses
19
Affichages
639
moupa
M
Simbaa
  • Question
Microsoft 365 Création d'un fichier entier par rapport à des entrées via UserForm
Réponses
1
Affichages
365
job75
job75

Membres actuellement en ligne

1 membres et 28 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 294
Messages
2 086 895
Membres
103 404
dernier inscrit
sultan87