Comment consolider les données de tous les mois sur une feuil recap

BArack07

XLDnaute Nouveau
Bonjour,
EN effet, j'ai un soucis, j'e ne connais pas bien VBA et j'arrive pas à le faire sur Excel. évidemment j'ai cherché sur le forum mes j'ai pas trouvé un exemple qui colle à ma demande. je sollicite votre aide svp.

j'ai créé un fichier Excel avec 12 feuilles (mois de l'année). j'ai rajouté une 13 -ème feuilles qui s'appelle "recap", sur laquelle j'aimerais avoir l'ensemble des données saisies sur les 12 autres feuilles et de manière automatique.
le soucis est que dès fois je suis amener à corriger/rajouter des données sur une feuille antérieure.
j'aimerais avoir une solution svp, soit sur Excel ou sur VBA.
NB: le nombre de ligne par mois est variable.
ci-joint, le fichier Excel.

Merci d'avance
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour BArack07, bienvenue sur XLD,

Fichier joint avec cette macro dans la feuille "Recap" (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Activate()
Dim w As Worksheet, h&, hs&
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
    If w.Name <> Me.Name Then
        With w.[A2].CurrentRegion
            h = .Rows.Count - 1
            If h > 0 Then
                .Offset(1).Resize(h).Copy Range("A3").Offset(hs)
                hs = hs + h
            End If
        End With
    End If
Next
End Sub
Elle se déclenche quand on active la feuille.

A+
 

Fichiers joints

BArack07

XLDnaute Nouveau
Bonjour BArack07, bienvenue sur XLD,

Fichier joint avec cette macro dans la feuille "Recap" (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Activate()
Dim w As Worksheet, h&, hs&
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
    If w.Name <> Me.Name Then
        With w.[A2].CurrentRegion
            h = .Rows.Count - 1
            If h > 0 Then
                .Offset(1).Resize(h).Copy Range("A3").Offset(hs)
                hs = hs + h
            End If
        End With
    End If
Next
End Sub
Elle se déclenche quand on active la feuille.

A+
Ohhhh, c'est magnifique
Merci pour la rapidité et l'efficacité
c'est pile poil ce que je voulais.

Merci
 

BArack07

XLDnaute Nouveau
Bonjour BArack07, bienvenue sur XLD,

Fichier joint avec cette macro dans la feuille "Recap" (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Activate()
Dim w As Worksheet, h&, hs&
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
    If w.Name <> Me.Name Then
        With w.[A2].CurrentRegion
            h = .Rows.Count - 1
            If h > 0 Then
                .Offset(1).Resize(h).Copy Range("A3").Offset(hs)
                hs = hs + h
            End If
        End With
    End If
Next
End Sub
Elle se déclenche quand on active la feuille.

A+
Bonjour Job75
En effet, depuis la dernière fois, j'ai essayer d'apporter quelque réglage sur le fichier que tu m'avais fais, mais j'arrive pas. Par exemple, j'aurai besoin de ramener la ligne d'entête (ligne 3) à la 14 -ème ligne. dès que je le fais, ça ne marche plus comme avant. du coup j'ai récréé un nouveau fichier que j'ai joint et j'ai besoin de ton aide stp.
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour BArack07,

L'adaptation est pourtant évidente :
VB:
Private Sub Worksheet_Activate()
Dim w As Worksheet, h&, hs&
Application.ScreenUpdating = False
Rows("15:" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
    If w.Name <> Me.Name Then
        With w.[A14].CurrentRegion
            h = .Rows.Count - 1
            If h > 0 Then
                .Offset(1).Resize(h).Copy Range("A15").Offset(hs)
                hs = hs + h
            End If
        End With
    End If
Next
End Sub
A+
 

Fichiers joints

BArack07

XLDnaute Nouveau
Bonjour BArack07,

L'adaptation est pourtant évidente :
VB:
Private Sub Worksheet_Activate()
Dim w As Worksheet, h&, hs&
Application.ScreenUpdating = False
Rows("15:" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
    If w.Name <> Me.Name Then
        With w.[A14].CurrentRegion
            h = .Rows.Count - 1
            If h > 0 Then
                .Offset(1).Resize(h).Copy Range("A15").Offset(hs)
                hs = hs + h
            End If
        End With
    End If
Next
End Sub
A+
Merci beaucoup JOB75, vous êtes génial et sympa sur cette page
si je rajoute une nouvelle feuille qui constituera ma base de donnée pour faire une liste déroulante sur les autres feuilles, comment faire en sorte que ma BDD ne soit pas pris en compte dans mon onglet synthèse stp
Regarde ma feuille de janvier avec les liste déroulante

merci d'avance
 

BArack07

XLDnaute Nouveau
Merci beaucoup JOB75, vous êtes génial et sympa sur cette page
si je rajoute une nouvelle feuille qui constituera ma base de donnée pour faire une liste déroulante sur les autres feuilles, comment faire en sorte que ma BDD ne soit pas pris en compte dans mon onglet synthèse stp
Regarde ma feuille de janvier avec les liste déroulante

merci d'avance
 

Fichiers joints

job75

XLDnaute Barbatruc
On va continuer longtemps comme ça ? Remplacer :
VB:
    If w.Name <> Me.Name Then
par :
VB:
    If w.Name <> Me.Name And w.Name <> "BDD" Then
 

BArack07

XLDnaute Nouveau
On va continuer longtemps comme ça ? Remplacer :
VB:
    If w.Name <> Me.Name Then
par :
VB:
    If w.Name <> Me.Name And w.Name <> "BDD" Then
Mdr, Merci à toi et j'espere que j'aurai plus à te fatiguer.
Si seulement tu savais ma joie, je te remercie mille fois, j'espere qu'un jour je pourrais te rendre service aussi
merci, merci et encore merci
 

Haut Bas