Tranpositions de noms en fonction de critères

Bonjour à tous,

je me permet de vous solliciter pour une requête surement très simple pour vous mais infaisable pour moi

dans l'exemple ci-dessous, je cherche à transposer les noms de la feuille 1 (correspondant à la date et au code) dans la cellule correspondante en feuille 2.

en espérant avoir été claire.

Si en plus il est possible de générer le tableau en feuille 2 (au niveau date et code) je serai la plus heureuse

Merci d'avance pour votre aide

Sophie

Bonjour,

Les noms seulement ? (sans les équipes)

Plusieurs noms dans la même cellule : quelle disposition ?

Cordialement.

Bonjour,

Oui juste les nom sous forme de liste de préférence dans une seule cellule

Et oui tous les noms concernés dans la même cellule

A tester :

Sub GénérerTablo()
    Dim Tbl(), d As Object, dD As Object, dc As Object, k, kc, n%, i%
    Set d = CreateObject("Scripting.Dictionary")
    Set dD = CreateObject("Scripting.Dictionary")
    Set dc = CreateObject("Scripting.Dictionary")
    With Worksheets("Feuil1")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            k = .Cells(i, 4).Value2: kc = .Cells(i, 3)
            dD(k) = "": dc(kc) = "": k = k & "|" & kc
            If d.exists(k) Then
                d(k) = d(k) & Chr(10) & .Cells(i, 1)
            Else
                d(k) = .Cells(i, 1)
            End If
        Next i
    End With
    ReDim Tbl(dD.Count, dc.Count)
    Tbl(0, 0) = "DATE": n = 0: i = 0
    For Each k In dD.keys
        n = n + 1: Tbl(n, 0) = k
    Next k
    For Each kc In dc.keys
        i = i + 1: Tbl(0, i) = kc
    Next kc
    For n = 1 To UBound(Tbl, 1)
        For i = 1 To UBound(Tbl, 2)
            k = Tbl(n, 0) & "|" & Tbl(0, i)
            If d.exists(k) Then Tbl(n, i) = d(k)
        Next i
    Next n
    n = UBound(Tbl, 1) + 1: i = UBound(Tbl, 2) + 1
    kc = RGB(221, 235, 247)
    Application.ScreenUpdating = False
    With Worksheets.Add(after:=Worksheets("Feuil1"))
        .Rows(1).RowHeight = 42
        .Rows(3).Resize(n - 1).RowHeight = 115
        .Columns(2).Resize(, i - 1).ColumnWidth = 29
        With .Range("A2").Resize(n, i)
            .Value = Tbl
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Borders.Weight = xlThin
            .Font.Size = 8
            .Rows(1).Interior.Color = kc
            With .Columns(1)
                .Interior.Color = kc
                .NumberFormat = "dd/mm/yyyy"
            End With
        End With
    End With
End Sub

Cordialement.

Merci bcp MFerrand.

C'est exactement ce que j'avais en tête.

Petite question supplémentaire :

Je rempli le fichier de saisie tous les jours, est-il possible de mettre à jour le tableau en cliquant sur le bouton, plutôt que de créer une nouvelle feuille à chaque fois.

Bien entendu, il me suffit de supprimer l'ancienne à chaque MAJ. Mais on sait jamais

Mais je te suis entièrement reconnaissante pour ta précieuse aide

Sophie

Remplace :

...
    With Worksheets.Add(after:=Worksheets("Feuil1"))
        .Rows(1).RowHeight = 42
...

par :

...
    With Worksheets("Feuil2")
        .UsedRange.Clear
        .Rows(1).RowHeight = 42
...

Cordialement.

Génial c'est juste parfait

Encore merci pour ton aide

Sophie