Copier des cellules distinctes de plusieurs fichiers Excel

Bonjour à tous,

Je crée une macro qui doit recopier (ou mieux relier) des cellules distinctes de plusieurs fichiers Excel portant des noms différents mais tous dans le même répertoire vers un fichier Excel de résumé.

Donc je veux copier par ex les cellule A1, B2, B3 et F5 de chaque fichier vers les cellules A1, B1, D1, F1 (1er fichier), A2, B2, D2, F2 (2ème fichier)... de mon fichier résumé.

Je me suis inspiré d'un code mis en ligne par ThauThème en 2017 mais qui copie une plage et non des cellules distinctes. Le code à modifier est le suivant:
'******************************************************************************************* 

' cette partie correspond à ta macro du copier/coler. Adapte là à ton cas 'définit la cellule de destination DEST (première cellule vide de la colonne A) 

Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 

OS.Range("A1:H50").Copy DEST 

'copie la plage A1:H50 de l'onglet source et la colle dans DEST 'sinon, tu supprimes cette partie et tu lances ta propre macro '*******************************************************************************************

Le code complet est ici:

Sub Macro1() Dim BDD As FileDialog 'déclare la variable BDD (Boîte de Dialogue Dossier) 

Dim CA As String 'déclare la variable CA (Chemin d'Accès) 

Dim CD As Workbook 'déclare la variable CD (Classeur Destination) 

Dim OD As Worksheet 'déclare la variable OD (Onglet Destination) 

Dim FS As String 'décalre la variable FS (Fichier Source) 

Dim CS As Workbook 'déclare la variable CS (Classeur Source) 

Dim OS As Worksheet 'déclare la variable OS (Onglet Source) 

Dim DEST As Range 'déclare la variable DEST (celllue de DESTination) 

 'Si tu connais le chemin d'accès et qu'il ne bougera pas écris-le en-dessous et supprime la partie indiquée si... 'ici --> CA = "ton_Chemin" & "\" 

 'lignes à supprimer si... 'définit la boîte de dialogue BDD (permetant de définit le dossier des fichiers source) 

Set BDD = Application.FileDialog(msoFileDialogFolderPicker) 

With BDD 'prend en compte BDD 

 .AllowMultiSelect = False 'n'autorise qu'une seule sélection 

 .Show 'affiche BDD 

 If .SelectedItems.Count = 0 Then Exit Sub 'si bouton [Annuler], sort de la procédure 

 CA = .SelectedItems(1) & "\" 'définit la chemin d'accès CA aux fichiers à ouvrir 

End With 'fin de la prise en compte de BDD 'fin des lignes à supprimer si... 

 Set CD = ThisWorkbook 'définit la classeur destination CD 

Set OD = CD.Sheets(1) 'définit l'onglet destination OD (à adapter à ton cas, ici j'ai mis le premier onglet) 

FS = Dir(CA & "*.xlsx") 'définit le premier fichier source Excel contenu dans le dossier ayant CA comme chemin d'accès 

Do While FS <> "" ' exécute tant qu'il existe des fichiers source 

 Workbooks.Open CA & FS 'ouvre le fichier source FS 

 Set CS = ActiveWorkbook 'définit la classeur source CS 

 Set OS = CS.Worksheets(1) 'définit l'onglet source OS (à adapter à ton cas, ici j'ai j'ai mis le premier onglet) '******************************************************************************************* 

 ' cette partie correspond à ta macro du copier/coler. Adapte là à ton cas 'définit la cellule de destination DEST (première cellule vide de la colonne A) 

 Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 

 OS.Range("A1:H50").Copy DEST 'copie la plage A1:H50 de l'onglet source et la colle dans DEST 

 'sinon, tu supprimes cette partie et tu lances ta propre macro '******************************************************************************************* 

 'call MaMacro 

 CS.Close False 'ferme le claseru source CS (sans enregistrer) 

 FS = Dir 'définit le prochain fichier source excel du dossier ayant CA comme chemin d'accès 

Loop 'boucle 

End Sub

Salut,

Ta demande n'est pas des plus claire, par exemple :

Donc je veux copier par ex les cellule A1, B2, B3 et F5 de chaque fichier vers les cellules A1, B1, D1, F1 (1er fichier), A2, B2, D2, F2 (2ème fichier)... de mon fichier résumé.

Mais si tu veux reporter des cellules distinctes de fichiers-source vers un fichier-cible, tu aurais la solution dans le fichier cible ci-joint.

Les 3 fichiers joints doivent être placés dans le même répertoire, tel que tu indiques que sont les tiens. Les fichiers sources restent fermés.

Selon la configuration de tes fichiers réels, il faudra éventuellement modifier cette macro pour la simplifier, par exemple si l'on peut effectuer des boucles. Mais comme tu ne livres pas tes fichiers, impossible d'en savoir plus pour l'instant.

Cordialement.

MM

Merci pour ta réponse. Je joins les fichiers. Test1, 2 et 3 sont mes sources (en réalité, j'en ai des centaines qui portent des noms de personne), classeur1 ma destination. Dans classeur1, j'ai mis en ex. le résultat que je dois obtenir. Et donc il faut remplacer les 2 lignes suivantes de la macro par les cellules des sources à copier dans les cellules de destination

Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) OS.Range("A1:H50").Copy DEST 'copie la plage A1:H50 de l'onglet source et la colle dans DEST

Re,

Tu avais réellement mal expliqué ton problème, car selon tes nouveaux fichiers, c'est bien différent.

J'ai modifié mon code afin qu'il passe en revue tous les noms que tu as dans ta colonne A du fichier-cible et qu'il aille chercher les données voulues dans autant de fichiers-source. Il faut que les noms en colonne A et les noms des fichiers à visiter correspondent exactement, si ce n'est que le code semble insensible à la casse.

Mon code est placé dans le module 1.

Sincèrement.

Merci Yvouille.

Ta macro marche bien dans mon répertoire de test avec tes fichiers. Mais je l'ai adapté à mon répertoire et aux cellules que je veux copier. Il ouvre mon 1er fichier et plante sur la 1ère ligne de copie wsData.Range("B3").Copy wsMaster.Cells(i, 1)

Je joins le fichier modifié et 3 fichiers réels

Si tu peux encore m'aider, ce serait sympa.

Je crois qu'on a une discussion à deux vitesses.

Je t'ai proposé une nouvelle solution en plaçant une nouvelle macro dans le Module 1 de ton projet, macro qui est lancée par le bouton en place sur la feuille du ficher Cible. Cette macro fonctionne parfaitement selon la configuration de ton fichier cible, tel que tu me l'as présenté hier à 13 heures.

Tu me fournis maintenant un fichier cible dans lequel les noms des fichiers ont disparu et tu m'indiques une instruction wsData.Range("B3").Copy wsMaster.Cells(i, 1) qui ne fait pas partie de ma macro, mais d'une ancienne macro déjà en place.

De plus tu fournis tes fichiers au compte-gouttes ; aujourd'hui tu te décides enfin à me fournir des fichiers-source qui semblent plus proche de la réalité.

Si tu es intéressé à ce que je continue de t'aider, dis-moi si l'on a une liste des fichiers à visiter sur le fichier-cible - tel que présenté hier - ou non et indique-moi quels sont les cellules des fichiers-source qui doivent être reportées et où.

De plus, je continue à modifier ma macro dans le but de résoudre ton problème - puisque j'ai déjà bien avancé dans ce sens - mais je ne vais pas m'intéresser à tes autres macros déjà en place.

A te relire.

Merci de ta patience. Je suis désolé de mélanger un peu tout. Si je comprends bien, tu as fait 2 macro sans tenir compte de ma macro de départ. Donc je vais supprimer ma macro.

Ma configuration est bien celle que je t'ai envoyée tout à l'heure. J'ai appelé mes fichiers alpha, Beta et Gamma pour des raisons de RGPD. Les noms de fichiers sont des noms de personnes. Je n'en ai pas la liste (il y en a 400 +/-). Donc la macro doit parcourir mon répertoire (les fichiers sont tous au même endroit.

Si je résume, je supprime la macro1 que tu n'utilises pas. Je clique sur le bouton report et ta macro doit fonctionner, peu importe le nombre de fichiers?

Encore merci, ça faisait des jours que je ramais et je n'avais personne pour m'aider.

Depuis le début, je soupçonnais qu'il n'était pas nécessaire de passer en revue tous les fichiers d'un dossiers et tes explications n'ont pas aidé à comprendre ton besoin - surtout lorsque tu m'as fourni ce fichier avec la liste des fichiers en place sur la feuille du fichier-cible - à comprendre que j'avais tors.

Maintenant il est clair qu'il faut passer en revue tous les fichiers d'un dossier et j'ai modifié ma macro en conséquence. Tu ne réponds pas à mes questions et ne m'as pas indiqué quelles cellules des fichiers-source devaient être reportées à quels endroits du fichier-cible. Pour l'exemple, j'ai donc considéré qu'il fallait reporter les cellules B39 et E39 de tous les fichiers-source. J'ai considéré que - comme dans tes exemples, toutes les feuilles des fichiers sources s'appellent ''Feuil1'' et que tous les fichiers-source sont de type .xlsx.

Dans le fichier cible, j'ai prévu une ligne de titre qui doit absolument resté en place, sinon il faudra modifier la macro en conséquence. Tel que prévu dans cette démo, les données en place aux lignes 2 et suivantes sont à chaque fois effacées et remplacées par les nouvelles données.

La macro reporte également le nom des fichiers-source en colonne A.

Toutes les autres macros du fichier cible ont été supprimées.

Je te remercie. Je vais tester cela demain.

Bonne soirée

Bonjour,

Je viens de le tester sur mes fichiers de production. C'est génial car tu ne copies pas, tu fais la liaison. C'est ce que je veux depuis le début. Le problème, c'est qu'il s'arrête sur le fichier 24. Il affiche le fichier mais n'affiche pas les liens pour ce fichier et s'arrête sur la ligne:

Range("B" & Ligne).FormulaLocal = "='" & Chemin & "[" & Fichier_traité & "]" & Onglet & "'!" & Adresse

Tu as une idée de ce qui peut l'arrêter?

Bonne journée,

Georges

J'ai trouvé ce qui coince: certains noms de fichiers utilisent une apostrophe. Je les modifie en enlevant l'apostrophe et ça fonctionne. Merci pour tout.

Georges