Bonsoir mika89, Steelson
Vois ceci :
Option Explicit
Sub test()
Dim a, b(), i As Long, n As Long
a = Sheets("extraction").Range("a1").CurrentRegion.Value
ReDim b(1 To UBound(a, 1), 1 To 3)
With CreateObject("Scripting.Dictionary")
For i = 3 To UBound(a, 1)
If Not .exists(a(i, 1)) Then
n = n + 1: .Item(a(i, 1)) = n
b(n, 1) = a(i, 1)
b(n, 2) = a(i, 2)
b(n, 3) = a(i, 7)
Else
b(.Item(a(i, 1)), 3) = b(.Item(a(i, 1)), 3) + a(i, 7)
End If
Next
End With
With Sheets("BIOLAM LCD").Range("d6").Resize(n, UBound(b, 2))
.Value = b
End With
End Sub
klin89