XL 2013 (RESOLU) Récapitulation des Feuilles 'Traitement Absence' dans la Feuille 'Traitement Absence Global'

chaelie2015

XLDnaute Accro
Bonsoir Forum
J'ai huit feuilles sources dont le nom commence par 'Traitement Absence' (de 'Traitement Absence', 'Traitement Absence (2)', ..., 'Traitement Absence (8)'). Ensuite, j'ai une feuille récapitulative nommée 'Traitement Absence Global'. Chaque feuille source contient un tableau de F3:K34. Dans les feuilles source, la ligne numéro 3 contient une formule qui génère un mois au format 'mm' (un numéro de mois), et la ligne numéro 4 contient une formule qui génère une date. Les autres lignes, de 5 à 34, affichent automatiquement des dates.

Mon objectif est de créer une récapitulation de toutes les feuilles sources dans la feuille de destination 'Traitement Absence Global' automatiquement, en évitant les doublons des mois et des dates. Je souhaite également inclure leur titre, qui se trouve dans la cellule B1 fusionnée de chaque feuille source.
Vous trouverez ci-joint un exemple de fichier à titre d'illustration.
Merci d'avance.
 

Pièces jointes

  • Charlie Fichier global V1.xlsm
    55.8 KB · Affichages: 22
Solution
Bonjour chaelie2015, gbinforme,

A partir du fichier du post #1 voici une solution qui utilise 2 colonnes auxiliaires :
VB:
Private Sub Worksheet_Activate()
Dim deb As Range, n, x$, dat&, lig&, r As Range, decal%, j%, i&
Set deb = [F4]
Application.ScreenUpdating = False
deb(0).Resize(Rows.Count - deb.Row + 2, Columns.Count - deb.Column + 1).ClearContents 'RAZ
'---liste des dates---
Columns("A:B").Insert 'insère 2 colonnes auxiliaires
For n = 2 To Worksheets.Count
    x = Worksheets(n).Range("B1")
    For dat = Worksheets(n).Range("B3") To Worksheets(n).Range("D3")
        If dat > 0 Then
            lig = lig + 1
            Cells(lig, 1) = CDate(dat)
            Cells(lig, 2) = x
        End If
Next dat, n
If lig = 0 Then...

chaelie2015

XLDnaute Accro
Bonsoir,

J'avais bien compris ton souhait mais comme c'est assez complexe, il fallait avoir le temps de le coder.
Le voici
Bonsoir gbinforme
C'est excellent😍, je vous remercie pour votre réponse. 👍
Cependant, après avoir illustré différents cas et effectué des tests, j'ai remarqué (voir le fichier exemple) que les dates ne sont pas triées dans l'ordre dans la colonne L de la feuille Globale.
Exemple : J'ai ajouté une date dans la feuille 'Traitement Absence (4)' le 28/11/2023, et dans la feuille 'Traitement Absence (8)', j'ai noté une période de maternité du 11/11/2023 au 27/11/2023. Dans la feuille globale 'Traitement Absence Global' pour le mois numéro 11 (colonne L), les dates ne sont pas triées dans l'ordre.
Merci par avance
 

Pièces jointes

  • Charlie Fichier global V gbinforme .xlsm
    61.6 KB · Affichages: 4

job75

XLDnaute Barbatruc
Bonjour chaelie2015, gbinforme,

A partir du fichier du post #1 voici une solution qui utilise 2 colonnes auxiliaires :
VB:
Private Sub Worksheet_Activate()
Dim deb As Range, n, x$, dat&, lig&, r As Range, decal%, j%, i&
Set deb = [F4]
Application.ScreenUpdating = False
deb(0).Resize(Rows.Count - deb.Row + 2, Columns.Count - deb.Column + 1).ClearContents 'RAZ
'---liste des dates---
Columns("A:B").Insert 'insère 2 colonnes auxiliaires
For n = 2 To Worksheets.Count
    x = Worksheets(n).Range("B1")
    For dat = Worksheets(n).Range("B3") To Worksheets(n).Range("D3")
        If dat > 0 Then
            lig = lig + 1
            Cells(lig, 1) = CDate(dat)
            Cells(lig, 2) = x
        End If
Next dat, n
If lig = 0 Then Columns("A:B").Delete: Exit Sub
Set r = [A1].CurrentRegion.Columns(1).Cells
r.Resize(, 2).Sort r(1), xlAscending, Header:=xlNo 'tri
'---remplissage du tableau---
deb = r(1)
deb(0) = DateSerial(Year(deb), Month(deb), 1)
For Each r In r
    decal = Month(r) - Month(deb) + 12 * (Year(r) - Year(deb))
    If decal > 0 Then
        For j = 1 To decal
            deb(0, 1 + 2 * j) = DateAdd("m", j, deb(0))
        Next j
        Set deb = deb.Offset(, 2 * decal)
        i = 0
    End If
    i = i + 1
    deb(i) = r
    deb(i, 2) = r(1, 2)
Next r
Columns("A:B").Delete 'supprime les 2 colonnes auxiliaires
End Sub
La macro est placée dans le code de la 1ère feuille et se déclenche quand on active cette feuille.

A+
 

Pièces jointes

  • Charlie Fichier global V1.xlsm
    65.5 KB · Affichages: 6

chaelie2015

XLDnaute Accro
Bonjour chaelie2015, gbinforme,

A partir du fichier du post #1 voici une solution qui utilise 2 colonnes auxiliaires :
VB:
Private Sub Worksheet_Activate()
Dim deb As Range, n, x$, dat&, lig&, r As Range, decal%, j%, i&
Set deb = [F4]
Application.ScreenUpdating = False
deb(0).Resize(Rows.Count - deb.Row + 2, Columns.Count - deb.Column + 1).ClearContents 'RAZ
'---liste des dates---
Columns("A:B").Insert 'insère 2 colonnes auxiliaires
For n = 2 To Worksheets.Count
    x = Worksheets(n).Range("B1")
    For dat = Worksheets(n).Range("B3") To Worksheets(n).Range("D3")
        If dat > 0 Then
            lig = lig + 1
            Cells(lig, 1) = CDate(dat)
            Cells(lig, 2) = x
        End If
Next dat, n
If lig = 0 Then Columns("A:B").Delete: Exit Sub
Set r = [A1].CurrentRegion.Columns(1).Cells
r.Resize(, 2).Sort r(1), xlAscending, Header:=xlNo 'tri
'---remplissage du tableau---
deb = r(1)
deb(0) = DateSerial(Year(deb), Month(deb), 1)
For Each r In r
    decal = Month(r) - Month(deb) + 12 * (Year(r) - Year(deb))
    If decal > 0 Then
        For j = 1 To decal
            deb(0, 1 + 2 * j) = DateAdd("m", j, deb(0))
        Next j
        Set deb = deb.Offset(, 2 * decal)
        i = 0
    End If
    i = i + 1
    deb(i) = r
    deb(i, 2) = r(1, 2)
Next r
Columns("A:B").Delete 'supprime les 2 colonnes auxiliaires
End Sub
La macro est placée dans le code de la 1ère feuille et se déclenche quand on active cette feuille.

A+
Bonsoir JOB, gbinforme
Une réponse idéale et instantanée, merci a vous.
A+
 

Discussions similaires

Statistiques des forums

Discussions
312 803
Messages
2 092 256
Membres
105 318
dernier inscrit
alberic63