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

adilprodigy

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
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

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+
 

Fichiers joints

Dernière édition:

adilprodigy

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
 

adilprodigy

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
 

job75

XLDnaute Barbatruc
Bonjour adilprodigy, le forum,
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
Remplacez :
VB:
For Each w In Worksheets
    If w.Name <> Me.Name Then
par :
VB:
For Each w In Worksheets
    If w.Name Like "##_##" Then
Bon dimanche.
 
Ce message a été identifié comme étant une solution!

adilprodigy

XLDnaute Impliqué
Bonjour adilprodigy, le forum,

Remplacez :
VB:
For Each w In Worksheets
    If w.Name <> Me.Name Then
par :
VB:
For Each w In Worksheets
    If w.Name Like "##_##" Then
Bon dimanche.
Merci beaucoup @job75 ça marche correctement.

Bon début de semaine
 

adilprodigy

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
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour adilprodigy,

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

Pareil pour les dates.

A+
 

adilprodigy

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
 

Fichiers joints

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.
 

Fichiers joints

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas