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