Microsoft 365 import fichier fermé sous condition

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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 :mad:
Pourriez-vous m'aider ?
Je joins les fichiers tests.

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

Pièces jointes

  • Clients.xlsm
    39 KB · Affichages: 21
  • test_adrMail.xlsm
    28.5 KB · Affichages: 9
Dernière édition:
Solution
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 :
VB:
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 =...

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

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

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

Jacky67

XLDnaute Barbatruc
Bonjour,
Peut-être comme ceci.
En adaptant le chemin du classeur "Clients"
VB:
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é
 
Dernière édition:

job75

XLDnaute Barbatruc
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 :
Code:
=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+
 

Pièces jointes

  • test_adrMail.xlsm
    29.9 KB · Affichages: 7
  • Clients.xlsm
    39.5 KB · Affichages: 5

Jacky67

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Supporter XLD
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 :mad:
VB:
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

XLDnaute Barbatruc
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 :mad:
VB:
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
VB:
CheminDuClasseurClient = ThisWorkbook.Path & "\"
Dans le code précédent, j'avais oublié de modifier le chemin dans la 2ème partie du code.

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
 
Dernière édition:

job75

XLDnaute Barbatruc
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 :
VB:
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
 

Pièces jointes

  • test_adrMail(1).xlsm
    32.2 KB · Affichages: 4
  • Clients.xlsm
    36.8 KB · Affichages: 4

Discussions similaires

Réponses
16
Affichages
513

Statistiques des forums

Discussions
312 215
Messages
2 086 330
Membres
103 188
dernier inscrit
evebar