Compiler dans une seule feuille des lignes de plusieurs fichiers

Bonjour,

La gestion des heures de mon entreprise se fait grâce à un fichier excel qui porte le nom du collaborateur et qu'il remplit chaque jour. Il y a une feuille par mois et une feuille de récapitulation annuelle (voir le fichier joint pour la feuille récap)

Pour obtenir des indicateurs sur l'absentéisme et autres, je souhaiterai copier la ligne "total" de chaque feuille "Récap" de chaque fichier de collaborateur et la compiler dans une seule et unique feuille avec en début de ligne le nom du collaborateur. Ainsi j'aurai les heures totales de chaque collaborateur dans un seul et unique fichier.

Je ne maîtrise pas du tout le VBA et cherche une âme charitable qui pourrait éventuellement me donner un petit coup de main.

Un grand merci pour vos réponses

Bonjour Sylvain,

à tester, à adapter la variable MonChemin aver le dossier qui contient l'ensemble des fichiers:

Sub Recap()
'https://forum.excel-pratique.com/viewtopic.php?f=2&t=132351&sid=aec6956ac1d586507cd9d124e33aebf5

    Dim MonChemin As String, MesFichiers As String
    Dim sFichiers() As String, Fnum As Long
    Dim MonFichier As Workbook
    Dim DerLig As Integer

    DerLig = 1

    'Chemin contenant tes fichiers
    MonChemin = "C:\Users\Username\Desktop\Forum\" 'Chemin à adapter

    'quitter la macro si le dossier est vide
    MesFichiers = Dir(MonChemin & "*.xl*")
    If MesFichiers = "" Then
        MsgBox "Le dossier ne contient pas de fichiers"
        Exit Sub
    End If

    'Remplit le tableau avec la liste des fichiers
    Fnum = 0
    Do While MesFichiers <> ""
        Fnum = Fnum + 1
        ReDim Preserve sFichiers(1 To Fnum)
        sFichiers(Fnum) = MesFichiers
        MesFichiers = Dir()
    Loop

    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Boucle sur tous le fichiers
    If Fnum > 0 Then

        For Fnum = LBound(sFichiers) To UBound(sFichiers)
            Set MonFichier = Nothing
            On Error Resume Next
            Set MonFichier = Workbooks.Open(MonChemin & sFichiers(Fnum))
            On Error GoTo 0

            If Not MonFichier Is Nothing Then

                On Error Resume Next

                With ThisWorkbook.Worksheets(1)
                    .Range("A" & DerLig) = MonFichier.Worksheets("Récap").Range("Y2")
                    .Range("B" & DerLig).Resize(, 29).Value = MonFichier.Worksheets("Récap").Range("B21").Resize(, 29).Value

                    DerLig = DerLig + 1

                End With

                MonFichier.Close savechanges:=True

            End If

        Next Fnum

    End If

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlAutomatic
    End With

End Sub

Cordialement

Bonjour,

Un exemple réalisé avec Power Query.

Décompresse l'archive zip et ouvre le classeur Rapport_annuel v1.xlsx.

Pour actualiser les données : Ruban, Données, Actualiser tout…

Fais un test en mettant tes vrais fichiers !...

Tous les classeurs doivent être évidemment identiques et ne comporter qu'une feuille de calcul.

A te relire.

Cdlt.