Microsoft 365 import fichier fermé sous condition

[Usine à gaz]

Bonsoir à toutes et à tous,

J'ai besoin d'importer des informations provenant d'un fichier fermé.
Le contexte
Dans le même dossier j'ai :
1 classeur "Clients" qui contient les informations à importer,
1 classeur "test_adrMail" qui reçoit les informations
Pour faire mes importations j'utilise la code de Pierre - tatiak (encore merci à toi) qui fonctionne nickel.

Le besoin
Toutefois, dans le cas qui me préoccupe, j'ai besoin de faire ces importations sous condition :
- Pour les N° dans fichier Clients feuille "Données"- col"B"
- qui correspondent aux N° fichier test_adrMail feuille "Mails_Clients"- col"D"
Import adresses mails Clients feuille "Données"- col"A" dans fichier test_adrMail feuille "Mails_Clients"- col"C"

J'ai tenté mais je ne sais pas faire 😡
Pourriez-vous m'aider ?
Je joins les fichiers tests.

Avec mes remerciements,
Je vous souhaite à toutes et à tous une douce nuit,
lionel

 

[Usine à gaz]

Bonjour à toutes et à tous,

je continue à chercher le bon codage ... sans succès pour l'instant.
Voici le résultat attendu de ma demande :

Bonne journée à toutes et à tous,
lionel 🙂

 

[Jacky67]

Bonjour,
Peut-être comme ceci.
En adaptant le chemin du classeur "Clients"

Sub test_import()
    Dim Plage, CheminDuClasseurClient$
    Set Plage = Range("c2:c" & Cells(Rows.Count, "D").End(xlUp).Row)
    CheminDuClasseurClient = "D:\Mes Téléchargement\" '*********** Adapter le chemin du classeur Clients **********
    With Plage
       .Formula = "=IFERROR(INDEX('" & CheminDuClasseurClient & "[Clients.xlsm]Données'!$a:$a,MATCH(d2,'" & CheminDuClasseurClient & "[Clients.xlsm]Données'!$b:$b,0)),"""")"
       .Value = .Value
    End With
End Sub

**Modifié

 

[Usine à gaz]

Bonjour Jacky67

merci à toi 🙂
Je vais tester et je reviens,
lionel,

 

[job75]

Bonjour Lionel, Jacky67,

Il n'y a pas besoin de VBA, de simples formules de liaison en C2 suffisent.

Ouvrez les 2 fichiers joints et formule en C2 du 1er fichier, à tirer vers le bas :

=SIERREUR(LIEN_HYPERTEXTE(INDEX([Clients.xlsm]Données!$A$2:$A$10000;EQUIV(D2;[Clients.xlsm]Données!$B$2:$B$10000;0)));"")

Mais bien sûr il faut mettre de l'ordre dans les données des 2 fichier : les n° de clients doivent impérativement être de même nature, voyez les fichiers joints et les tests en rouge.

Les colonnes de ces n° sont au format Texte et les cellules ont été revalidées.

A+

 

[Usine à gaz]

Re-Bonjour Jacky67

Désolé ça ne semble pas fonctionner ou je n'ai pas su adapter.
Le code cherche à ouvrir un fichier alors que c'est un import d'un fichier fermé (sans l'ouvrir).
Je continue mes recherches.
lionel,

 

[Usine à gaz]

Bonjour Gérard,
Merci d'être là 🙂
je teste et je reviens.

 

[Jacky67]

Re-Bonjour Jacky67

Désolé ça ne semble pas fonctionner ou je n'ai pas su adapter/
Le code cherche à ouvrir un fichier alors que c'est un import d'un fichier fermé (sans l'ouvrir).
Je continue mes recherches.
lionel,

Hello job75 🙂
Re..
Mes tests sont concluants....
Si une ouverture de classeur est demandée, il y a une erreur sur le chemin (complet) du classeur "Clients" ou sur son nom

 

[Usine à gaz]

Re_Gérard,

Super ça fonctionne 🙂
Merci encore une fois
Je vais tenter de comprendre
lionel,

 

[Usine à gaz]

Hello Jacky67,
Je vais regarder 🙂

 

[Usine à gaz]

Hello Jacky67,
J'aurais bien voulu tester ton code mais je n'arrive pas à l'adapter
Voilà ce que j'ai tenté mais ça ne fonctionne pas 😡

Sub test_import()
    Dim Plage, CheminDuClasseurClient$
    Set Plage = Range("c2:c" & Cells(Rows.Count, "D").End(xlUp).Row)
    CheminDuClasseurClient = "c:\AdrMails_Cherche" '*********** Adapter le chemin du classeur Clients **********
    With Plage
        .Formula = "=IFERROR(INDEX('" & CheminDuClasseurClient & "[Clients.xlsm]Données'!$a:$a,MATCH(d2,'c:\AdrMails_Cherche\[Clients.xlsm]Données'!$b:$b,0)),"""")"
        .Value = .Value
    End With

Dans mon ordi, les 2 fichiers sont :
- sur mon disque C,
- sur le bureau,
- dans le dossier "AdrMails_Cherche"
lionel,

 

[Jacky67]

Hello Jacky67,
J'aurais bien voulu tester ton code mais je n'arrive pas à l'adapter
Voilà ce que j'ai tenté mais ça ne fonctionne pas 😡

Sub test_import()
    Dim Plage, CheminDuClasseurClient$
    Set Plage = Range("c2:c" & Cells(Rows.Count, "D").End(xlUp).Row)
    CheminDuClasseurClient = "c:\AdrMails_Cherche" '*********** Adapter le chemin du classeur Clients **********
    With Plage
        .Formula = "=IFERROR(INDEX('" & CheminDuClasseurClient & "[Clients.xlsm]Données'!$a:$a,MATCH(d2,'c:\AdrMails_Cherche\[Clients.xlsm]Données'!$b:$b,0)),"""")"
        .Value = .Value
    End With

Dans mon ordi, les 2 fichiers sont :
- sur mon disque C,
- sur le bureau,
- dans le dossier "AdrMails_Cherche"
lionel,

RE..
"c:\AdrMails_Cherche"
Il manque l'antislash à la fin
"c:\AdrMails_Cherche\"
Si les 2 fichiers sont dans le même dossier
Alors tu peux remplacer
"c:\AdrMails_Cherche"
par

CheminDuClasseurClient = ThisWorkbook.Path & "\"

Dans le code précédent, j'avais oublié de modifier le chemin dans la 2ème partie du code.

Sub test_import()
    Dim Plage, CheminDuClasseurClient$
    Set Plage = Range("c2:c" & Cells(Rows.Count, "D").End(xlUp).Row)
    CheminDuClasseurClient = ThisWorkbook.Path & "\"
    With Plage '
        .Formula = "=IFERROR(INDEX('" & CheminDuClasseurClient & "[Clients.xlsm]Données'!$a:$a,MATCH(d2,'" & CheminDuClasseurClient & "[Clients.xlsm]Données'!$b:$b,0)),"""")"
        .Value = .Value
    End With
End Sub

Enregistre le classeur et teste

 

[Usine à gaz]

Hello Jacky67,
merci super ça fonctionne 🙂
lionel

 

[job75]

Allons Lionel, ni la solution de Jacky67 ni la mienne du post #5 ne conviennent.

En effet les liens hypertextes d'origine ne sont pas copiés.

Pour qu'ils soient copiés il n'y a pas d'autre solution que d'ouvrir le fichier source :

Sub test_import()
Dim chemin$, fichier$, F As Worksheet, i&, j As Variant
chemin = ThisWorkbook.Path & "\"
fichier = "Clients.xlsm"
If Dir(chemin & fichier) = "" Then MsgBox "Le fichier '" & fichier & "' est introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'sécurité, désactive les évènements
Application.DisplayAlerts = False 'si le fichier source est ouvert
On Error Resume Next: Workbooks(fichier).Close: On Error GoTo 0 'on le ferme
Set F = Sheets("Mails_Clients")
F.Range("C2:C" & Rows.Count).Clear 'RAZ
With Workbooks.Open(chemin & fichier).Sheets(1).[A1].CurrentRegion 'ouvre le fichier source
    .Borders.LineStyle = xlNone 'supprime les bordures
    For i = 2 To .Rows.Count
        j = Application.Match(.Cells(i, 2), F.Columns(4), 0) 'recherche en colonne D
        If IsNumeric(j) Then .Cells(i, 1).Copy F.Cells(j, 3) 'copier-coller
    Next
    .Parent.Parent.Close 'ferme le fichier source
End With
With F.UsedRange: End With 'actualise la barre de défilement verticale
Application.EnableEvents = True 'réactive les évènements
End Sub

 

[Usine à gaz]

Re_Gérard,
"Allons Lionel, ni la solution de Jacky67 ni la mienne du post #5 ne conviennent."
je ne comprends pas car pourtant, les 2 solutions importent bien les adresses mails souhaitées.

Je vais revoir les tests.
Merci Gérard pour cette 3eme solution 🙂
Je reviendrai te dire.
lionel 🙂