Macro pour récupérer les données de différents fichiers

  • Initiateur de la discussion Initiateur de la discussion trome
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

trome

XLDnaute Nouveau
Macro pour récupérer les données de différents fichiers


Bonjour à tous!

Novice en macro (et formules avancées), je viens solliciter votre aide pour le problème suivant:


J'ai X fichiers différents contenant tous un onglet "SYNTHESE".
Cet onglet a une structure identique, en terme de colonnes mais pas en nombre de lignes.

Par exemple, pour 1 fichier "Suivi X":


Cellules - Indicateur 1 - Indicateur 2
A10 - A - 1
A11 - B - 2
A12 - C - 3
A13 - D - 4
Puis ligne vide

> Soit 4 lignes de rempli

et pour un autre fichier "Suivi Y":
Cellules
A10 - E - 5
A11 - F - 6
A12 - G - 7
A13 - H - 8
A14 - I - 9
Puis ligne vide

> Soit 5 lignes de rempli

Je souhaiterais maintenant pouvoir récupérer dans 1 autre fichier (de façon automatisée) toutes les données des onglets "SYNTHESE" des différents fichiers
Pour avoir un onglet "TOTAL SYNTHESE" qui se présenterait
A2 - A - 1
A3 - B - 2
A4 - C - 3
A5 - D - 4
A6 - E - 5
A7 - F - 6
A8 - G - 7
A9 - H - 8
A10 - I - 9
Sans ligne vide


Merci d'avance à tous pour votre aide!
 
Re : Macro pour récupérer les données de différents fichiers

Bonjour trome,

la macro doit ouvrir les fichiers ou sont-ils déjà ouverts ?
Il y a une ligne de titre au-dessus de tes données ?

Si déjà ouverts et pas de ligne de titre

Code:
Sub SyntheseG()
Dim Wkb As Workbook, ResWkb As Workbook, Ligne As Long
    Set ResWkb = Workbooks.Add
    Ligne = 2
    For Each Wkb In Application.Workbooks
        If FeuilExist(Wkb.Name, "synthese") Then
            Wkb.Worksheets("synthese").Range("A10").CurrentRegion.Copy ResWkb.ActiveSheet.Cells(Ligne, 1)
            Ligne = ResWkb.ActiveSheet.Range("A65536").End(xlUp).Row + 1
        End If
    Next Wkb
    Application.CutCopyMode = False
End Sub

Function FeuilExist(NomClas As String, NomFeuil As String) As Boolean
Dim a As String
    FeuilExist = False
    On Error GoTo Err1
    a = Workbooks(NomClas).Worksheets(NomFeuil).Name
    On Error GoTo 0
    FeuilExist = True
    Exit Function
Err1:
End Function
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
20
Affichages
872
Retour