Consolider données plusieurs feuilles identiques en un tableau

[rcmelanie]

Bonjour à vous,

Auriez vous une astuce ou "macro" pour pouvoir recopier automatiquement les données de mes 15 feuilles dans un seul et même tableau récap ?

Je peux parfois supprimer des lignes dans des tableaux ou en rajouter donc il faudrait que le récap se mette à jour automatiquement

Je vous joins mon énorme fichier

A votre disposition pour tout renseignement

Je vous remercie d'avance pour l'aide que vous allez m'apporter

 

[Sauvage]

Re : Consolider données plusieurs feuilles identiques en un tableau

Bonjour,

Il y a plusieurs onglets " récap " dans le fichier.
Lequel faut-il remplir ?
Et quelles sont les informations à importer ?

 

[rcmelanie]

Re : Consolider données plusieurs feuilles identiques en un tableau

C'est le tout dernier onglet recap avec le tableau vide.

Il faudrait compiler tous les tableaux des onglets dans un seul

 

[Sauvage]

Re : Consolider données plusieurs feuilles identiques en un tableau

Voici un premier jet.

J'ai déplacé l'onglet récap dans les premiers onglets afin d'effectuer une boucle qui dit :
De l'onglet 6 (APT) jusqu'au dernier onglet (TARASC) copier toutes les lignes présentes dans les feuilles.

Précaution à prendre : Si il y a ajout ou suppression de feuille il faudra modifier une ou deux valeurs dans la macro car elle compte le nombre de feuille...

Quand vous êtes dans votre classeur, tapez ctrl + w pour lancer la mise à jour.

Dernière chose, la macro copie les lignes entières donc si vous rajoutez des colonnes dans les feuilles affectées aux MTI elles seront prises en compte.

Cordialement,

 

[Robert]

Re : Consolider données plusieurs feuilles identiques en un tableau

Bonsoir le fil, bonsoir le forum,

Peut-être comme ça :

Sub Macro1()
Dim r As Object 'déclare la variable r (onglet Recap)
Dim pae As Range 'déclare la variable pae (Plage À Effacer)
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

Set r = Sheets("recap") 'définit l'onglet recap
Set pae = r.Range("A1").CurrentRegion 'définit la plage à effacer pae
If pae.Rows.Count > 1 Then 'condition : si le nombre de lignes de la plage à effacer est supérieur à 1
    'redéfinit la plage à éfacer (sans la première ligne)
    Set pae = pae.Offset(1, 0).Resize(pae.Rows.Count - 1, pae.Columns.Count)
    pae.Clear 'efface la plage pae
End If 'fin de la condition
For Each o In Sheets 'boucle sur tous les onglets du classeur
    Select Case o.Name 'agit en fonction du nom de l'onglet
        Case "GENERAL", "SALARIES", "RECAP CONVOC", "recap" 'ne fait rien pour ces 4 onglet
        Case Else 'pour tous les autres onglets
            If o.Visible = False Then GoTo suite 'si l'onglet n'est pas visible va à l étiquette "suite"
            dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A) de l'onglet
            Set dest = r.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
            o.Range("A2").Resize(dl - 1, 11).Copy 'copy la plage utile de l'onglet
            dest.PasteSpecial (xlPasteValues) 'colle les valeurs dans la cellule de destination dest
    End Select 'fin de l'action en fonction du nom de l'onglet
suite: 'étiquette
Next o 'prochain onglet de la boucle
End Sub

Si tu modifies l'un des tableaux, relance la macro...

 

[job75]

Re : Consolider données plusieurs feuilles identiques en un tableau

Bonsoir à tous,

Voyez cette macro dans la feuille recap:

Private Sub Worksheet_Activate()
Dim lig&, w As Worksheet, h&, test As Boolean, col%
Application.ScreenUpdating = False
Rows("2:" & Rows.Count).Clear 'RAZ
lig = 2
For Each w In Worksheets
  If w.Name <> "recap" And w.[A1] = "NOM" Then
    h = w.Range("A" & Rows.Count).End(xlUp).Row - 1
    If h Then
      test = w.[D1] Like "POSTE*" 'feuille MIRAMAS
      col = IIf(test, 12, 11)
      w.[A2].Resize(h, col).Copy Cells(lig, 1) 'pour les formats
      Cells(lig, 1).Resize(h, col) = w.[A2].Resize(h, col).Value
      If test Then Cells(lig, "D").Resize(h).Delete xlToLeft
      lig = lig + h
    End If
  End If
Next
End Sub

Elle s'exécute quand on active la feuille recap.

Fichier joint.

A+

 

[job75]

Re : Consolider données plusieurs feuilles identiques en un tableau

Re,

Si l'on veut on peut faire un tri sur les noms à la fin :

[A1:K1].Resize(lig).Sort [A1], Header:=xlYes 'tri sur les noms

Fichier (2).

A+

 

[job75]

Re : Consolider données plusieurs feuilles identiques en un tableau

Re,

On aura remarqué bien sûr que quand on trie les bordures ne suivent pas.

Il est donc bien d'unifier l'épaisseur des bordures.

Il est bien aussi d'ajuster la largeur des colonnes :

[A:K].Resize(lig - 1).Borders.Weight = xlThin 'bordures
Columns("A:K").AutoFit 'ajustement de la largeur des colonnes

Fichier (3).

A+

 

[job75]

Re : Consolider données plusieurs feuilles identiques en un tableau

Bonjour le fil, le forum,

Chaque fois que la feuille recap est modifiée, la fonction volatile AUJOURDHUI() est recalculée.

De même que les formules qui y font référence dans toutes les feuilles.

Cela ralenti la macro, pour l'éviter utiliser :

Application.Calculation = xlCalculationManual 'évite le recalcul
'---
Application.Calculation = xlCalculationAutomatic

Fichier (4).

Edit : comme les tableaux ne sont pas très grands, la différence n'est pas importante : 0,20 s et 0,15 s.

A+

 

[job75]

Re : Consolider données plusieurs feuilles identiques en un tableau

Re,

On a bien compris que des formules des feuilles font appel à AUJOURDHUI().

Mais dans la feuille recap les données ne sont pas calculées par des formules.

Donc si l'on ouvrait le fichier avec recap comme feuille active, ou si à minuit on était sur cette feuille, recap ne se mettait pas à jour.

Pour y remédier je modifie le code de la feuille recap :

Private Sub Worksheet_Activate()
MAJ
End Sub

Sub MAJ()
Dim lig&, w As Worksheet, h&, test As Boolean, col%
Application.ScreenUpdating = False
Application.Calculate 'recalcule toutes les feuilles
Application.Calculation = xlCalculationManual 'évite le recalcul
Rows("2:" & Rows.Count).Clear 'RAZ
lig = 2
For Each w In Worksheets
  If w.Name <> "recap" And w.[A1] = "NOM" Then
    h = w.Range("A" & Rows.Count).End(xlUp).Row - 1
    If h Then
      test = w.[D1] Like "POSTE*" 'feuille MIRAMAS
      col = IIf(test, 12, 11)
      w.[A2].Resize(h, col).Copy Cells(lig, 1) 'pour les formats
      Cells(lig, 1).Resize(h, col) = w.[A2].Resize(h, col).Value
      If test Then Cells(lig, "D").Resize(h).Delete xlToLeft
      lig = lig + h
    End If
  End If
Next
[A:K].Resize(lig).Sort [A1], Header:=xlYes 'tri sur les noms
[A:K].Resize(lig - 1).Borders.Weight = xlThin 'bordures
Columns("A:K").AutoFit 'ajustement de la largeur des colonnes
Application.Calculation = xlCalculationAutomatic
End Sub

Et j'ajoute dans ThisWorkbook :

Private Sub Workbook_Open()
Feuil21.MAJ
Application.OnTime 0, "Feuil21.MAJ" 'mise à jour à minuit
End Sub

Fichier (5).

A+