Macro excel vba et copier coller entre classeur [Résolu/Fermé]

Signaler
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016
-
FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016
-
Bonjour,

Je souhaite votre aide pour créer une macro qui exécuterai cette tache :

- Copier le contenu de 5 cellules (A2, A4, A6, A8, A10) sur 50 tableurs excels de structure identiques localisés dans un dossier source.

- Coller ces contenus de cellule dans un tableur excel mère avec 1 ligne pour chaque tableur source. Chaque ligne aurait donc 5 colonnes remplies.

Le nombre de tableur source est en évolution.

Si l'un d'entre vous sait faire cette macro je lui demande son aide. ;)

4 réponses

Messages postés
16083
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
22 février 2020
2 877
Bonjour
Chaque ligne aurait donc 5 colonnes remplies.

Colonnes jointives ou toute les 2 colonnes? ou se trouve la copie de A2 ?

ou se trouve le classeur avec 5 cellules (A2, A4, A6, A8, A10)

les classeurs "cible" ont ils un nom générique et quel suffixe Excel ?

Merci d'^tre précis et complet dans votre demande
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 86825 internautes nous ont dit merci ce mois-ci

FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016

Michel_m

Oui chaque ligne du classeur mère aurait 5 colonnes remplies.

Il n'y a qu'une seule feuille dans les classeurs sources et mère

Les colonnes dans le classeur mère sont jointives.

La copie de A2 se trouve sur la cellule B2 du classeur mère,
La copie de A4 se trouve sur la cellule B3,
La copie de A6 se trouve sur la cellule B4,
La copie de A8 se trouve sur la cellule B5,
La copie de A10 se trouve sur la cellule B6.

Les classeurs cibles ont ce nom générique : "FO (X)" avec X allant de 1 à 50 minimum (le nombre n'est pas déterminé mais peut se limiter à 50).

S'il manque des informations je peux vous les fournir sans problème.
michel_m
Messages postés
16083
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
22 février 2020
2 877 > FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016

OK, merci

un oubli de ma part:
on copie uniquement des valeurs ?
copie en feuille1?

Classeur cible xls, xlm, xlsx, xlsm ?
FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016

Oui seuls des valeurs son ciblées

Toutes les données sont en feuille 1

Les tableurs sources sont en .xlsx et le tableur mère en .xlsm ;)
Messages postés
16083
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
22 février 2020
2 877
re
me re voilà j'avais pigé l'inverse!
pas la forme today !

sans ouvrir les classeurs TO;xlsx

Option Explicit
Const Chemin As String = "D:\docus\" 'A adapter au contexte

Sub compiler_N_classeurs()
Dim Lig As Integer, Fich As String
Application.ScreenUpdating = False
With ActiveSheet
ChDir Chemin
Fich = Dir("TO" & "*.xlsx")
Lig = 2
While Fich <> ""
.Cells(Lig, "B") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C1") 'R2C1=A2
.Cells(Lig, "C") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C3") 'C2
.Cells(Lig, "D") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C5") 'E2
.Cells(Lig, "E") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C7") 'G2
.Cells(Lig, "F") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C9") 'I2
Lig = Lig + 1
Fich = Dir
Wend
End With
End Sub
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 86825 internautes nous ont dit merci ce mois-ci

michel_m
Messages postés
16083
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
22 février 2020
2 877
n'aurais tu pas oublier l'antislash car chez moi ca marche (enfin!)


"C:\essai_copie\"
FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016
> michel_m
Messages postés
16083
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
22 février 2020

l'antislash est bien dans le chemin ciblée, j'ai intégré : Const Chemin As String = "C:\essai_copie\"

Je n'ai rien modifié d'autre.

Mon dossier est bien dans le lecteur C:

J'ai créé deux fichier sources nommés "FO(1)" et "FO(2)" dans lesquels les cellules A2,A4,A6,A8,A10 sont remplies (format de cellule texte) Ils sont ouverts avant l'exécution de la macro.

La macro est bien implantée dans le fichier mère "mere.xlsm" que j'ai placé dans le même dossier.

J'ai crée un bouton "controle de formulaire" pour exécuter la macro.

Je ne vois pas ce que qui cloche...
pijaku
Messages postés
12261
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 février 2020
2 338 > FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016

Dans la macro de Michel, écrire "FO" au lieu de "TO" :
Fich = Dir("TO" & "*.xlsx")
FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016
> pijaku
Messages postés
12261
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 février 2020

Oui en effet !!! Merci Pijaku ! ;)

Le code fonctionne :) le code ne sélectionne pas encore les bonnes cellules dans les "fichiers source" mais je peux corriger tout seul ce détail :) Merci beaucoup pour votre aide précieuse ! :)
FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016

Merci beaucoup pour votre aide !

Du coup j'utilise ce code :

Option Explicit
Const Chemin As String = "C:\essai_copie\"

Sub compiler_N_classeurs()
Dim Lig As Integer, Fich As String
Application.ScreenUpdating = False
With ActiveSheet
ChDir Chemin
Fich = Dir("FO" & "*.xlsx")
Lig = 2
While Fich <> ""
.Cells(Lig, "B") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C1") 'R2C1=A2
.Cells(Lig, "C") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C3") 'A4
.Cells(Lig, "D") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C5") 'A6
.Cells(Lig, "E") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C7") 'A8
.Cells(Lig, "F") = ExecuteExcel4Macro("'" & Chemin & "[" & Fich & "]Feuil1'!R2C9") 'A10
Lig = Lig + 1
Fich = Dir
Wend
End With
End Sub

La sélection des cellules dans les xlslx sources n'est pas encore bonne mais je peux modifier sans problème la sélection :)

Merci beaucoup pour votre aide !! :)
Messages postés
16083
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
22 février 2020
2 877
OK
A demain dans la matinée

encore une question !!!
type de données copiées: texte, nombre, date ?

 Michel
FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016

Les données copiées seront des textes ;)

D'accord, à demain, je resterai disponible: )

Bonne soirée
michel_m
Messages postés
16083
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
22 février 2020
2 877 > FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016

Bonjour
c'est parti
sois patient, y'a du boulot !
Messages postés
16083
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
22 février 2020
2 877
Re,

J'avais tenté un truc sans ouvrir les fichiers (rapidité) mais c'est refusé depuis XL2007, hélas! :-(


Important écrire le dossier de la constante "Chemin"

Option Explicit
Const Chemin As String = "D:\docus\" 'A adapter au contexte

Sub copier_dans_N_classeurs()
Dim Col As Byte, Tablo, Cptr As Byte, Fich As String

Application.ScreenUpdating = False
ReDim Tablo(4)
With ActiveSheet
'Mémorisation des données à copier
For Col = 1 To 9 Step 2
Tablo(Cptr) = .Cells(2, Col)
Cptr = Cptr + 1
Next
End With

ChDir Chemin
Fich = Dir("TO" & "*.xlsx")
While Fich <> ""
Workbooks.Open (Chemin & Fich)
With ActiveWorkbook
Sheets("feuil1").Range("B2").Resize(1, 5) = Tablo
.Save
.Close
End With
Fich = Dir
Wend
End Sub


 Michel
pijaku
Messages postés
12261
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 février 2020
2 338
Bonjour Michel,

Excuse l'incruste, mais je crois que tu as fait l'inverse de ce que demandais FixiF :
- Copier le contenu de 5 cellules (A2, A4, A6, A8, A10) sur 50 tableurs excels de structure identiques localisés dans un dossier source.

- Coller ces contenus de cellule dans un tableur excel mère avec 1 ligne pour chaque tableur source.

Les 5 cellules à copier sont dans les 50 classeurs, et ,il veut les coller dans un classeur "récap".
Ce qui t'as induit en erreur c'est ceci :
La copie de A2 se trouve sur la cellule B2 du classeur mère,
La copie de A4 se trouve sur la cellule B3,
La copie de A6 se trouve sur la cellule B4,
La copie de A8 se trouve sur la cellule B5,
La copie de A10 se trouve sur la cellule B6.

qu'il faut comprendre comme ceci, je pense :
La copie de A2 se trouve sur la cellule Bi du classeur mère,
La copie de A4 se trouve sur la cellule Ci,
La copie de A6 se trouve sur la cellule Di,
La copie de A8 se trouve sur la cellule Ei,
La copie de A10 se trouve sur la cellule Fi.
ou i est le numéro de la dernière ligne du classeur "mère" (récap)
pijaku
Messages postés
12261
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 février 2020
2 338
Si c'est le cas, et que je ne me goure pas, ce genre de code devrait convenir :
!!!Adapter les 3 constantes avec les noms des feuilles
Option Explicit

Const NomFeuilFichiers As String = "Feuil1" 'le nom commun à l'unique feuille des xxx fichiers
Const NomFeuilTemp As String = "Feuil2" 'le nom d'une autre feuille, vierge, du fichier mère
Const NomFeuilRecap As String = "Feuil1" 'le nom de la feuille du fichier mère qui accueille les données

Sub Import()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String

   Set objShell = CreateObject("Shell.Application")
   Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
   
   If objFolder Is Nothing Then
      MsgBox "Abandon opérateur", vbCritical, "Annulation"
   Else
      Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
      fichier = Dir(Chemin & "*.xlsx")
      Do While Len(fichier) > 0
         If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]" & NomFeuilFichiers & "'!$A$2:$A$10"
            With Sheets(NomFeuilTemp)
               .[A2:A10] = "=Plage"
               .Range("A2,A4,A6,A8,A10").Copy
               Sheets(NomFeuilRecap).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            End With
         End If
         fichier = Dir()
      Loop
      ThisWorkbook.Names("Plage").Delete
   End If
End Sub
FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016

Bonjour,

Désolé pour ma réponse tardive...

Je vais intégrer le code pour tester !

Mais oui en effet comme dit pikaju les 5 cellules à copier sont dans les 50 classeurs sources, et l'idée est de les coller dans le classeur mère (ou "récap").

Est ce qu'on s'est mal compris ?
FixiF
Messages postés
10
Date d'inscription
mardi 9 février 2016
Statut
Membre
Dernière intervention
10 février 2016

Re-bonjour !

Tout d'abord merci pour votre aide :)

j'ai donc testé les deux codes sources:

Le premier ne semble rien donner, l'implémentation de données dans le classeur mère ne s'effectue pas mais aucun message d'erreur.

Pijaku j'ai ensuite essayé ton code qui, une fois le dossier sélectionné, m'a écrit dans 5 colonnes sur une ligne "=page"

La partie du code :

With Sheets(NomFeuilTemp)
.[A2:A10] = "=Plage"

est elle à modifier ?

merci de votre aide :)