XL 2010 Grouper les données de plusieurs feuille sous un ordre exploitable

TheProdigy

XLDnaute Impliqué
Bonjour tout le monde,

Je souhaiterais grouper les données de plusieurs feuilles chaque feuille contient les données d'un mois mais venltilé sur plusieurs années (3) ( 2018 2019 2020).

Mon souhait est d'arriver à la feuille Objectif de telle sorte que toutes les données soit exploitable sous Tableau croisé dynamique

Imaginer 7 ou 8 mois et plusieurs sociétés une tache longue avec risque d'erreur

Merci à tous
 

Pièces jointes

  • Grouper feuilles.xlsx
    35.9 KB · Affichages: 11

job75

XLDnaute Barbatruc
Bonjour adilprodigy, danielco,

Oui, il faut une macro.

Voyez le fichier joint et cette macro dans le code de la feuille "Objectif" :
VB:
Private Sub Worksheet_Activate()
Dim an1%, an2%, an3%, lig&, w As Worksheet, P As Range, h&
an1 = 2018: an2 = 2019: an3 = 2020 'années à adapter
lig = 8 '1ère ligne de restitution, à adapter
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Rows(lig & ":" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
    If w.Name <> Me.Name Then
        If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
        Set P = w.Range("B8:G" & w.Range("B" & w.Rows.Count).End(xlUp).Row)
        If P.Row = 8 Then
            h = P.Rows.Count
            P.Resize(, 4).Copy Cells(lig, 2)
            lig = lig + h
            Union(P.Resize(, 3), P.Columns(5)).Copy Cells(lig, 2)
            Cells(lig, 4).Resize(h).Replace an1, an2, xlPart
            lig = lig + h
            Union(P.Resize(, 3), P.Columns(6)).Copy Cells(lig, 2)
            Cells(lig, 4).Resize(h).Replace an1, an3
            lig = lig + h
        End If
    End If
Next
End Sub
Elle se lance quand on active la feuille.

Edit : ajouté xlPart c'est plus sûr.

A+
 

Pièces jointes

  • Grouper feuilles(1).xlsm
    31.6 KB · Affichages: 11
Dernière édition:

TheProdigy

XLDnaute Impliqué
Bonjour adilprodigy, danielco,

Oui, il faut une macro.

Voyez le fichier joint et cette macro dans le code de la feuille "Objectif" :
VB:
Private Sub Worksheet_Activate()
Dim an1%, an2%, an3%, lig&, w As Worksheet, P As Range, h&
an1 = 2018: an2 = 2019: an3 = 2020 'années à adapter
lig = 8 '1ère ligne de restitution, à adapter
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Rows(lig & ":" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
    If w.Name <> Me.Name Then
        If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
        Set P = w.Range("B8:G" & w.Range("B" & w.Rows.Count).End(xlUp).Row)
        If P.Row = 8 Then
            h = P.Rows.Count
            P.Resize(, 4).Copy Cells(lig, 2)
            lig = lig + h
            Union(P.Resize(, 3), P.Columns(5)).Copy Cells(lig, 2)
            Cells(lig, 4).Resize(h).Replace an1, an2, xlPart
            lig = lig + h
            Union(P.Resize(, 3), P.Columns(6)).Copy Cells(lig, 2)
            Cells(lig, 4).Resize(h).Replace an1, an3
            lig = lig + h
        End If
    End If
Next
End Sub
Elle se lance quand on active la feuille.

Edit : ajouté xlPart c'est plus sûr.

A+
Bonsoir,

Merci beaucoup @job75 exactement ce que je voulais

Merci le forum
 

TheProdigy

XLDnaute Impliqué
Bonjour adilprodigy, danielco,

Oui, il faut une macro.

Voyez le fichier joint et cette macro dans le code de la feuille "Objectif" :
VB:
Private Sub Worksheet_Activate()
Dim an1%, an2%, an3%, lig&, w As Worksheet, P As Range, h&
an1 = 2018: an2 = 2019: an3 = 2020 'années à adapter
lig = 8 '1ère ligne de restitution, à adapter
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Rows(lig & ":" & Rows.Count).Delete 'RAZ
For Each w In Worksheets
    If w.Name <> Me.Name Then
        If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
        Set P = w.Range("B8:G" & w.Range("B" & w.Rows.Count).End(xlUp).Row)
        If P.Row = 8 Then
            h = P.Rows.Count
            P.Resize(, 4).Copy Cells(lig, 2)
            lig = lig + h
            Union(P.Resize(, 3), P.Columns(5)).Copy Cells(lig, 2)
            Cells(lig, 4).Resize(h).Replace an1, an2, xlPart
            lig = lig + h
            Union(P.Resize(, 3), P.Columns(6)).Copy Cells(lig, 2)
            Cells(lig, 4).Resize(h).Replace an1, an3
            lig = lig + h
        End If
    End If
Next
End Sub
Elle se lance quand on active la feuille.

Edit : ajouté xlPart c'est plus sûr.

A+
Il m'est interdit de travailler sur des feuilles du même classeur qui ne concernent pas cette finalité n'est ce pas? Est ce que on peut ajouter une condition pour que la Macro ne prenne que les feuilles de de format 01_20 02_20 03_20 etc parceque je serai condamné à utiliser le classeur que pour cette fin, j'ai peur que si j'ajoute d'autres feuilles la Macro applique des calculs ou beug?
Que me conseillez vous? je le laisse spécialement pour cette fin?

Merci
 

TheProdigy

XLDnaute Impliqué
Merci beaucoup @job75 ça marche correctement.

Bon début de semaine
Bonjour @job75 bonjour le Forum,

Je remplis le nom de la société et la date dans les colonne C et D manuellement, ma question est
comment insérer le nom de la société ( toutes les premières lettres à gauche de "A FIN")
dans la colonne C pour toutes les feuilles de nom sous format "##_##"?
Et la fin du mois dans la colonne D?
Ou bien sans les insèrer dans les feuilles "##_##" , on les intègre directement dans la feuille objectif

Merci
 

Pièces jointes

  • Grouper feuilles.xlsm
    46.3 KB · Affichages: 5

TheProdigy

XLDnaute Impliqué
Bonjour adilprodigy,

Si vous voulez remplacer le nom LANDA par autre chose utilisez la commande Remplacer (Ctrl+H).

Pareil pour les dates.

A+
Bonsoir,

Merci, je m'explique:

Pour que la feuille Objectif fonctionne je dois remplir le nom de la société et la date dans les colonne C et D manuellement à partir du titre en C4.
Est-ce qu'il y a un moyen pour que la feuille Objectif fonctionne sans saisir LANDA dans la colonne C et la date en colonne D ? juste à partir du titre cellule C4, Cad la Macro les calculent directement dans la feuille objectif parce qu il y a beaucoup de feuilles et beaucoup de nom de sociétés

Merci
 

Pièces jointes

  • Grouper feuilles.xlsm
    44.3 KB · Affichages: 4

job75

XLDnaute Barbatruc
Si vous souffrez d'ankylose voyez ce fichier (2) et la macro dans ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ot Sh.Name Like "##_##" Then Exit Sub
If Intersect(Target, Sh.[C4:D4]) Is Nothing Then Exit Sub
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
With Sh.Range("B8", Sh.Range("B" & Sh.Rows.Count).End(xlUp))
    If .Row < 8 Then Exit Sub
    .Columns(2) = Sh.[C4]
    .Columns(3) = Sh.[D4]
End With
End Sub
Elle se déclenche quand on modifie ou valide les cellules C4 ou D4 des feuilles concernées.
 

Pièces jointes

  • Grouper feuilles(2).xlsm
    47 KB · Affichages: 5

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 909
Membres
101 836
dernier inscrit
karmon