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

trome · 10 Août 2011

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!

tototiti2008 · 10 Août 2011

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

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

trome

XLDnaute Nouveau

tototiti2008

XLDnaute Barbatruc

Discussions similaires