Sub Version2()
Dim a, i As Long, j As Long, txt As String, n As Long
Application.ScreenUpdating = False
With Range("A2").CurrentRegion
a = .Value: n = 1
ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 1)
a(1, 1) = "Code client": a(1, 2) = "Raison sociale"
a(1, 3) = "Référence": a(1, 4) = "Nombre réf"
a(1, 5) = "Quantité": a(1, 6) = "Montant net HT"
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(a, 1)
txt = Join(Array(a(i, 1), a(i, 2), a(i, 3)), Chr(2))
If Not .exists(txt) Then
n = n + 1
For j = 1 To 3
a(n, j) = a(i, j)
Next
a(n, 6) = a(i, 4) * a(i, 5)
a(n, 5) = a(i, 4)
a(n, 4) = 1
.Item(txt) = n
Else
a(.Item(txt), 6) = a(.Item(txt), 6) + (a(i, 4) * a(i, 5))
a(.Item(txt), 5) = a(.Item(txt), 5) + a(i, 4)
a(.Item(txt), 4) = a(.Item(txt), 4) + 1
End If
txt = Empty
Next
End With
'Résultat dans la même feuille
With .Offset(, .Columns.Count + 1).Resize(n, UBound(a, 2))
.CurrentRegion.Clear
.Value = a
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Font.Name = "Calibri"
.Font.Size = 10
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
With .Rows(1)
.Font.Size = 11
.Interior.ColorIndex = 40
.BorderAround Weight:=xlThin
End With
.Columns(6).NumberFormat = "#,##0.00 €"
.Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Sub