Synthèse de tous les feuillets automatique

Question

Bonjour, 

Je suis sur un fichier Excel qui comporte un grand nombre de feuillet, je dois mettre chaque feuillet à jour puis copier ce qui ce trouve dans ce feuillet dans la feuille Synthèse à la main, ce qui est un peut lourd à faire surtout quand je dois répéter la manipulation 80 fois par jour vu que les tableaux sont continuellement mis à jour.
Chaque tableau dans mes feuilles sont totalement identiques, même nombre de colonne, seul le contenu change.
Je voudrai savoir si sa serai possible que ma feuille Synthèse regroupe tous le contenu de mes feuillets et prenne en compte automatiquement une nouvelle colonne de crée et une nouvelle feuille de crée.

Je joins un exemple pour que ce soit plus clair :
http://www.cjoint.com/c/GHqjmcNJFrD

En gros, la feuille synthèse dois regrouper tous le contenu de chaqu'une des autres feuilles, qu'elle ce mette à jour toutes seuls quand les feuillets sont mis à jour et qu'elle prenne en compte les nouvelles colonnes de crée dans les feuillets et les nouveaux feuillets de crée.

Je ne sais pas si c'est réalisable, j'ai cherché du côté des macros pour excel, mais ça n'est pas mon fort.

Merci d'avance pour votre aide.
Cordialement

eriiic · Answer

Bonjour,

oui, tu utilises mal excel et tu te donnes du travail inutile.
Une seule feuille de saisie. Ajoute une colonne Code à ta 1ère feuille où tu saisis AFH, AFR, etc
Ensuite avec un filtre mis sur les titres tu affiches celui que tu veux.
eric

Archer · Answer

Bonjour
Ta feuille FAH est pas bonne a toi de voir
Voila une Macro pour Faire les Récape

Sub TestRecap()
Dim Feuil As Object
Dim Onglet As String
Dim Slig, Nlig As Long
Onglet = Feuil1.Name
Feuil1.Select
Rows("2:" & Rows.Count).Clear
Application.ScreenUpdating = False
   For Each Feuil In Worksheets
      If Feuil.Name <> Onglet Then
         Slig = Feuil.Range("A" & Rows.Count).End(xlUp).Row
         If Slig > 1 Then
         Feuil.Range("A2:S" & Slig).Copy
         Nlig = Range("A" & Rows.Count).End(xlUp).Row + 1
         Range("A" & Nlig).PasteSpecial xlPasteValues
         End If
      End If
   Next
Application.CutCopyMode = False
End Sub

A+
Maurice

Elliot · Answer

Bonjour,

Je remonte le sujet, le code d'Archer marche très bien mais il ne prend pas compte à la mise en page dans les feuillets du ficher excel et j'aurai besoin qu'il prenne en compte les règles de mise en page comme la couleur du texte, la couleur de la case, le gras, souligné etc ....
Je ne sais pas si c'est possible par contre.

Merci d'avance pour votre aide, 
Cordialement

Archer · Answer

Bonjour
peux être comme ça

Sub TestRecap()
Dim Feuil As Object
Dim Onglet As String
Dim Slig, Nlig As Long
Onglet = Feuil1.Name
Feuil1.Select
Rows("2:" & Rows.Count).Clear
Application.ScreenUpdating = False
   For Each Feuil In Worksheets
      If Feuil.Name <> Onglet Then
         Slig = Feuil.Range("A" & Rows.Count).End(xlUp).Row
         If Slig > 1 Then
            Feuil.Range("A2:S" & Slig).Copy
            Nlig = Range("A" & Rows.Count).End(xlUp).Row + 1
            Range("A" & Nlig).PasteSpecial xlPasteAll
            Range("A" & Nlig).PasteSpecial xlPasteValues
         End If
      End If
   Next
Application.CutCopyMode = False
Application.Goto [A1], True
End Sub

A+
Maurice

Elliot · Answer

Bonjour,

Merci pour le code, ça marche :)

Cordialement

Elliot · Answer

Bonjour,


Je ne voudrais pas trop abuser de votre temps, j'ai une dernière demande à vous faire, je dois exclure 2 feuillets de la formule pour qu'ils ne soient pas comptabilisé dans le feuille Synthèse, comment puis-je faire ?

Merci d'avance pour votre aide,
Cordialement

Archer · Answer

bonjour
a toi de mettre le bon CodeName
A+
Maurice

Sub TestRecap()
Dim Feuil As Object
Dim Onglet As String
Dim Onglet1 As String
Dim Onglet2 As String
Dim Slig, Nlig As Long
Onglet = Feuil1.Name
Onglet1 = Feuil3.Name
Onglet2 = Feuil13.Name
Feuil1.Select
Rows("2:" & Rows.Count).Clear
Application.ScreenUpdating = False
   For Each Feuil In Worksheets
      If Feuil.Name <> Onglet And Feuil.Name <> Onglet1 And Feuil.Name <> Onglet2 Then
         Slig = Feuil.Range("A" & Rows.Count).End(xlUp).Row
         If Slig > 1 Then
            Feuil.Range("A2:S" & Slig).Copy
            Nlig = Range("A" & Rows.Count).End(xlUp).Row + 1
            Range("A" & Nlig).PasteSpecial xlPasteAll
            Range("A" & Nlig).PasteSpecial xlPasteValues
         End If
      End If
   Next
Application.CutCopyMode = False
Application.Goto [A1], True
End Sub

Synthèse de tous les feuillets automatique

7 réponses

Discussions similaires

Newsletters