XL 2010 Synthèse automatique de plusieurs feuilles

[RNS]

Bonjour,

J'ai besoin de votre aide. J'ai regardé plusieurs discussions mais aucune ne m'a éclairée.

J'ai dans un fichier quelques onglets qui contiennent un nombre différent de données. Toutefois, elles ont toutes le même gabarit. Le résultat que je recherche, est une consolidation de toutes les lignes des différents onglets dans un même onglet nommé "Synthèse".

Avec le temps, certaines lignes s'ajouteront et d'autres seront supprimées. L'onglet synthèse devra alors s'ajuster aux nouvelles données.

Merci à l'avance !

 

[Hieu]

Salut,

Une solution par macro :

Sub mlk()
Range(Range("A2"), Selection.End(xlToRight).End(xlDown)).ClearContents
k = 2
For Each s In Sheets
If s.Name <> "Synthese" And s.Name <> "Explications" Then
    For i = 2 To s.Range("a65536").End(xlUp).Row
    s.Rows(i).Copy
    Sheets("Synthese").Rows(k).PasteSpecial
    k = k + 1
    Next i
End If
Next s
End Sub

 

[BOISGONTIER]

Bonjour,

cf PJ

Copie chaque feuille en une seule fois.

Sub consolide_onglets()
  Sheets("synthese").[A1].CurrentRegion.Offset(1, 0).Clear
  For s = 3 To Sheets.Count
  Range(Sheets(s).[A2], Sheets(s).[A65000].End(xlUp).End(xlToRight)).Copy [A65000].End(xlUp).Offset(1, 0)
  Next s
End Sub

http://boisgontierjacques.free.fr/pages_site/GestionOnglets.htm#Consolidation

ou

Sub auto_open()
  Sheets("synthese").Activate
  Sheets("synthese").[A1].CurrentRegion.Offset(1, 0).Clear
  For s = 3 To Sheets.Count
  Range(Sheets(s).[A2], Sheets(s).[A65000].End(xlUp).End(xlToRight)).Copy [A65000].End(xlUp).Offset(1, 0)
  Next s

End Sub

JB

 

[job75]

Bonjour RNS, Hieu, JB, le forum,

Plutôt que de copier les lignes une par une il est beaucoup plus rapide de copier entièrement chaque feuille :

Private Sub Worksheet_Activate()
Dim a, w As Worksheet, h&
a = Array("Feuil1", "Feuil2") 'CodeNames des feuilles à exclure
Application.ScreenUpdating = False
Rows("2:" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
  If IsError(Application.Match(w.CodeName, a, 0)) Then
    w.UsedRange.Offset(1).Copy Cells(2 + h, 1)
    h = h + w.UsedRange.Rows.Count
  End If
Next
Me.UsedRange.Sort [A1], Header:=xlYes 'tri sur colonne A
End Sub

Bonne journée.

 

[RNS]

Bonjour,

Je dois avouer que c'est au delà de mes espérances, ça fonctionne vraiment bien.

Sincères remerciement pour vos réponses...

Si je pousse ma chance plus loin, Y aurait moyen d'activer la macro en ouverture de fichier?

 

[job75]

Re,

Si je pousse ma chance plus loin, Y aurait moyen d'activer la macro en ouverture de fichier?

Pas besoin de pousser, la mienne s'exécute quand on active la feuille...

A+