Boucle compléter base de donnée et fichiers fermés

Bonjour le forum

Dans le dossier en pièce jointe j'ai placé un fichier avec lequel je cherche à:

1 - Récupérer des données d'une liste vers une autre en fonction d'une valeur commune

2 - Aller coller ces valeurs dans autant de fichiers correspondant à la liste

Il y a déjà un code qui me permet de boucler sur les fichiers fermés pour récupérer des données, mais je ne sais pas comment l'inverser en fait

Si quelqu'un pouvait y jeter un oeil

D'avance je vous remercie pour votre aide et votre disponibilité

Bonjour le Forum

J en e désespère pas avoir de l'aide, mais j'essaie d'avancer

ci-dessous un code pour rechercher, ouvrir et fermer les classeurs excel à compléter

mais c'est la boucle que je ne sais pas faire

Sub ADR_COM()
'Déclaration des variables
Dim myPath As String, myFile As String

'chemin du répertoire qui contient les fichiers avec l'onglet "Feuil1"
myPath = "C:\Users\...\Desktop\test"

'Permet de récupérer le nom des fichiers du répertoire
myFile = Dir(myPath & "\*.xlsx")

'Boucle sur l'ensemble des fichiers du répertoire
Do While myFile <> ""
    'On appelle la fonction "ClasseurOuvert" définie plus bas : elle permet de vérifier si le classeur est ouvert du répertoire. Sinon, cette fonction ouvre le classeur.
    Call ClasseurOuvert(myPath & "\" & myFile)

    'Avec le classeur ouvert ou qu'on vient d'ouvrir...
    With Workbooks(myFile)

        'Ma macro

        'En partant de la feuille contenant le nom du fichier à ouvrir en colonne "A", copier les information des cellules en colonne B(i),C(i) et D(i)
        'et les coller dans la 'Feuil1' du fichier ouvert en cellules "E3" pour B(1), "K3" pour c(i) et "B10" pour D(i)
        ' "nom" en cellule

        'On ferme le classeur
        .Close
    End With
    'Et on passe au suivant
    myFile = Dir()
Loop

End Sub

Function ClasseurOuvert(NomFich)
On Error Resume Next
    Workbooks(NomFich).Activate
    If Err <> 0 Then Workbooks.Open Filename:=NomFich
On Error GoTo 0
End Function

Des exemples de fichiers à compléter sont contenus dans le zip de mon premier post

Merci pour votre aide

Bonsoir Eole, bonsoir le forum,

C'est pas très clair dans le Zip tu dois renseigner le chemin d'accès dans une cellule et pas dans le dernier fichier ?!...

Je te propose le code ci-dessous, à affecter au bouton,qui va d'abord te permettre de sélectionner le dossier puis faire la boucle :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim D As FileDialog 'déclare la variable D (Dossier)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim I As Integer 'déclare la variable I (Incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
Set D = Application.FileDialog(msoFileDialogFolderPicker) 'définit le dossier D via la boîte de dialogue "Parcourir"
D.AllowMultiSelect = False 'n'autorise la sélection que d'un seul dossier
D.Show 'affiche la boîte de dialogue
'si au moins un dossier a été sélectionné, définit le chemin d'accès CA
If D.SelectedItems.Count > 0 Then CA = D.SelectedItems(1) & "\"
F = Dir(CA & "*.xls?") 'Définit le premier Fichier Excel F du dossier D
Do While F <> "" 'exécute tant qu'il existe des fichiers
    If Not F = CS.Name Then 'condition : si F n'est pas le classeur source
        I = I + 1 'incrémente I
        Set CD = Workbooks.Open(CA & F) 'définit le claseur destination CD en l'ouvrant
        Set OD = CD.Worksheets(1) 'définit l'onglet destination OD
        OD.Range("E3").Value = OS.Cells(I, "B").Value 'récupère en E3 de l'onglet OD la valeur de la cellule ligne I colonne B de OS
        OD.Range("K3").Value = OS.Cells(I, "C").Value 'récupère en K3 de l'onglet OD la valeur de la cellule ligne I colonne C de OS
        OD.Range("B10").Value = OS.Cells(I, "D").Value 'récupère en B10 de l'onglet OD la valeur de la cellule ligne I colonne D de OS
        CD.Close True 'ferme le claseur destination en enregistrant les modification
        F = Dir 'définit le prochain fichier F du dossier D
    End If 'fin de la condition
Loop 'boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Données traitées !" 'message
End Sub

Bonjour le Forum

Bonjour ThauThème

Désolé pour la réponse tardive, mais souci Covid...

Merci beaucoup,

C'est pile poil ce qu'il me fallait

Ca fonctionne impec

Une grosse et belle épine du pieds que tu m'enlèves ThauThème

merci beaucoup