Bonsoir,
Une idée à améliorer bien entendu:
Sub Macro1()
Columns("C:C" ).Select
Selection.NumberFormat = "@"
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(60000, 2).End(xlUp).Select
fincol = Selection.Row
For i = 1 To fincol
maval = Cells(i, 2)
Cells(i, 3) = " "
virg = " "
Columns("B:B" ).Select
With Selection
Set c = .Find(maval, after:=Cells(64000, 2), LookIn:=xlValues)
cc = c.Row
If (Not c Is Nothing) And c.Row <> i Then
Cells(i, 3) = virg & Str(Cells(c.Row, 1).Value)
virg = ", "
End If
firstAddress = c.Address
Do
Set c = .FindNext(c)
If (Not c Is Nothing) And c.Row <> i And c.Address <> firstAddress Then
Cells(i, 3) = Cells(i, 3) & virg & Str(Cells(c.Row, 1).Value)
virg = ", "
End If
Loop While Not c Is Nothing And c.Address <> firstAddress
End With
Next
End Sub
Cordialement