Faire la synthèse de 12 onglets

[altinea]

Bonjour et tous mes voeux pour cette nouvelle année, j'en profite pour remercier tous les participants et l'aide qu'ils m'ont apporté.

Je souhaiterai faire une compil des infos de 12 onglets "colonne B", se trouvent les noms des praticiens, ceux ci peuvent être présents plusieurs fois par mois et tous les mois.
Dans la feuille synthèse colonne A, j'aimerai avoir le noms de ces même praticiens mais une seule fois, même s'ils sont présents plusieurs fois par mois et tous les mois.

Merci pour votre aide

 

[klin89]

Re : Faire la synthèse de 12 onglets

Bonsoir altinea

A adapter et ajuster :

Sub Essai()
Dim e, el
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each e In [{"Janvier","Février"}]
            For Each el In Sheets(e).Range("B2", Sheets(e).Range("B" & Rows.Count).End(xlUp)).Value
                If el <> "" Then .Item(el) = Empty
            Next
        Next
        If .Count > 0 Then
            Sheets("Synthèse").Range("A2").Resize(.Count).Value = _
            Application.Transpose(.keys)
        End If
    End With
End Sub

klin89

 

[altinea]

Re : Faire la synthèse de 12 onglets

Bonjour le forum, Klin89, merci pour ta proposition, ça fonctionne, le seul petit hic, est qu'il me reprends la cellule B1, dans la synthèse, voir fichier joint onglet synthèse cellule A8, pourrais tu m'indiquer ce que je pourrais faire pour modifier le code, merci

 

[klin89]

Re : Faire la synthèse de 12 onglets

Re altinea

A placer dans un module standard :

Sub Essai()
Dim e, derlig As Long, c As Range
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each e In [{"Janvier","Février","Mars","Avril","Mai"}]
            derlig = Sheets(e).Range("B" & Rows.Count).End(xlUp).Row
            If derlig > 1 Then
                For Each c In Sheets(e).Range("B2", Sheets(e).Range("B" & Rows.Count).End(xlUp))
                    '.Item(c.Value) = IIf(.Exists(c.Value), .Item(c.Value) + 1, 1)
                    If c.Value <> "" Then .Item(c.Value) = Empty
                Next c
            End If
        Next
        If .Count > 0 Then
            Sheets("Synthèse").Range("A2").Resize(.Count).Value = _
            Application.Transpose(.keys)
        End If
    End With
End Sub

Ou :

Sub Essai1()
Dim ws As Worksheet, derlig As Long, c As Range, x, n As Long
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each ws In Worksheets
            Select Case ws.Name
                Case "Synthèse", "Données"
                Case Else
                    derlig = ws.Range("B" & Rows.Count).End(xlUp).Row
                    If derlig > 1 Then
                        For Each c In ws.Range("B2", ws.Range("B" & Rows.Count).End(xlUp))
                            If c.Value <> "" Then .Item(c.Value) = Empty
                        Next
                    End If
            End Select
        Next
        x = .keys: n = .Count
    End With
    If n > 0 Then
        Sheets("Synthèse").Range("A2").Resize(n).Value = Application.Transpose(x)
    End If
End Sub

klin89

 

[altinea]

Re : Faire la synthèse de 12 onglets

le forum, klin89, merci
puis je te demander un dernier petit élement, lorsque je supprime un item, celui ci reste présent dans la feuille synthèse, même s'il ne figure pas dans d'autres onglets, y a t'il une astuce pour faire un refresch et actualiser les infos, merci

 

[altinea]

Re : Faire la synthèse de 12 onglets

RE en fait en mettant un bouton et la macro dans la feuille synthèse cela permet de mettre a jour, merci encore