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

gbinforme à dit:

Bonsoir,

J'avais bien compris ton souhait mais comme c'est assez complexe, il fallait avoir le temps de le coder.
Le voici

Cliquez pour agrandir...

job75 à dit:

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+

Cliquez pour agrandir...