Ranger des Noms en lignes, par colonnes en fonction de dates

Bonsoir,

Je sollicite votre aide pour

1- savoir s'il est possible de renvoyer en colonnes des noms qui sont alignés selon des dates...

et 2- si en plus il était possible de concaténer avec le nom, la valeur de la cellule adjacente...

mais mieux qu'un long discours, je joint une fichier avec en

page 1 les noms en lignes,

page 2 tels que je voudrais les voir rangés en colonnes...

Merci d'avance.

DAVID

bonjour

un essai de faisabilité ; l'automatisation sera a ameliorer

regarde le format de cel utilisé

cordialement

Bonsoir tulipe_4, dadaetkarin, le forum

A tester :

Restitution en Feuil3 préalablement créée.

A condition que les dates soient triées, sinon il faut le faire autrement.

Option Explicit

Sub Reorganise()
Dim a, b(), i As Long, maxRow As Long, j As Long, w()
    a = Sheets("Feuil1").Range("a1").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1), 1 To 1)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                j = j + 1
                If j > UBound(b, 2) Then
                    ReDim Preserve b(1 To UBound(b, 1), 1 To j)
                End If
                b(1, j) = a(i, 1)
                .Item(a(i, 1)) = VBA.Array(1, j)
            End If
            w = .Item(a(i, 1))
            w(0) = w(0) + 1
            b(w(0), w(1)) = a(i, 2) & vbLf & a(i, 3)
            maxRow = Application.Max(maxRow, w(0))
            .Item(a(i, 1)) = w
        Next
    End With
    Application.ScreenUpdating = False
    'Restitution en feuil3
    With Sheets("Feuil3")
        .Cells.Clear
        With .Range("a1").Resize(maxRow, UBound(b, 2))
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .Interior.ColorIndex = 42
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
        End With
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

Au moins, les explications sont claires, bravo David

klin89

Bonjour,

merci tulip_4, j'ai essayé et effectivement ça fonctionne..

J'ai cependant testé la macro de klin89 et ma fois ça fonctionne aussi, en automatique...

Donc merci à vous 2 pour la réponse si rapide..

Je suis toujours aussi fasciné par les capacités d'Excel et du VBA...

encore merci à vous 2.

Bonne journée.

DAVID