Bonjor NedStark, gmb
vois ceci :
Option Explicit
Sub test()
Dim a, b(), i As Long, j As Long, n As Long, dico As Object, e
Set dico = CreateObject("Scripting.Dictionary")
dico.comparemode = 1
With Sheets("1").Range("A1").CurrentRegion
a = .Value
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
For i = 2 To UBound(a, 1)
If UCase(a(i, 4)) = UCase(Sheets("2").Range("A1").Value) Then
If Not dico.exists(a(i, 1)) Then
n = n + 1
For j = 1 To UBound(a, 2) - 1
b(n, j) = a(i, j)
Next
dico.Item(a(i, 1)) = n
Else
For j = 2 To UBound(a, 2) - 1
b(dico.Item(a(i, 1)), j) = b(dico.Item(a(i, 1)), j) + a(i, j)
Next
End If
End If
Next
For Each e In dico.keys
b(dico.Item(e), UBound(b, 2)) = b(dico.Item(e), 2) / b(dico.Item(e), 3)
Next
End With
With Sheets("2").Range("A1")
.CurrentRegion.Offset(2).Clear
If n > 0 Then
.Offset(2).Resize(n, UBound(b, 2)).Value = b
Else
MsgBox "aucune donnée"
End If
End With
Set dico = Nothing
End Sub
klin89