XL 2019 Macro : Ouvrir un fichier, exécuter une macro dans ce fichier puis exporter les données vers un autre classeur

CiolBel

XLDnaute Nouveau
Bonjour à toutes et à tous!

Vous avez eu la gentillesse de me filer un coup de main il y a quelques mois dans l'élaboration d'un classeur de travail qui fonctionne à merveille et je reviens vers vous pour vous demander un coup de main complémentaire.

Présentation du cas en pièce jointe :

Dans le dossier MacroTest, j'ai:
- Deux classeurs, ClasseurA et ClasseurB avec la même structure. Les deux classeurs sont dans des dossiers différents (Dossier1 et Dossier2)
- Chaque classeur contient un onglet "Synth" et des onglets Data1, Data2, Data3, etc. et une macro "Macro1"
- La macro "Macro1" va chercher les valeurs des cellules depuis les onglets Data vers l'onglet "Synth" et les lister ligne par ligne (chaque onglet Data a sa ligne propre)

- Un fichier ClasseurPrimaire.xlsm qui sert a agréger les données.

Je souhaite créer deux macros dans ClasseurPrimaire.xlsm :

1. D'abord, ouvrir les Classeurs A et B, exécuter "Macro1" pour avoir les données les plus à jour puis copier le contenu de chaque Onglet Synth à la suite dans ClasseurPrimaire.

2. Si dans une ligne de ClasseurPrimaire, les cellules des colonnes D à I contiennent uniquement le signe "-", supprimer la ligne entière.

Est-ce que l'un d'entre vous qui n'aurait pas non plus la chance d'être en vacances se sentirait de me donner des pointeurs? Je ne sais pas par quel bout le prendre!

Bien à vous,

CiolBel
 

Pièces jointes

  • MacroTest.zip
    52.9 KB · Affichages: 14

CiolBel

XLDnaute Nouveau
J'y suis presque! La macro suivante ouvre les classeurs, exécute la macro, copie et les données, ferme les classeurs sans enregistrer (ce que je souhaite) et remet le primaire au premier plan...

Y-a-t-il plus élégant que de répéter le code pour chaque cible? (j'en ai une vingtaine dans 8 sous-dossiers dans la réalité)

VB:
Sub OpenRunMacroandCopy()

Workbooks.Open fileName:="C:\Users\CM_PROJET_03\Desktop\MacroTest\Dossier1\ClasseurA.xlsm"
Application.Run "ClasseurA.xlsm!Macro1"

Workbooks.Open fileName:="C:\Users\CM_PROJET_03\Desktop\MacroTest\Dossier2\ClasseurB.xlsm"
Application.Run "ClasseurB.xlsm!Macro1"

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

    Set wsCopy = Workbooks("ClasseurA.xlsm").Worksheets("Synth")
    Set wsDest = Workbooks("ClasseurPrimaire.xlsm").Worksheets("Feuil1")
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
  wsCopy.Range("B2:I5" & lCopyLastRow).Copy _
    wsDest.Range("B" & lDestLastRow)
    
    Set wsCopy = Workbooks("ClasseurB.xlsm").Worksheets("Synth")
    Set wsDest = Workbooks("ClasseurPrimaire.xlsm").Worksheets("Feuil1")
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
  wsCopy.Range("B2:I5" & lCopyLastRow).Copy _
    wsDest.Range("B" & lDestLastRow)

Workbooks("ClasseurA.xlsm").Close SaveChanges:=False
Workbooks("ClasseurB.xlsm").Close SaveChanges:=False

ThisWorkbook.Activate


End Sub

Par ailleurs, des idées pour un code "Si signe moins dans chaque cellule entre les colonnes D et I, supprimer la ligne?"
 
Dernière édition:

Discussions similaires

M
Réponses
9
Affichages
466
Maikales
M

Statistiques des forums

Discussions
312 084
Messages
2 085 192
Membres
102 810
dernier inscrit
mohammedaminelahbali