Sub CreerTableau()
Dim d As Object, tablo, t
Set d = CreateObject("Scripting.Dictionary")
tablo = Sheets("base").Range("B2", Sheets("base").[B65536].End(xlUp))
For Each t In tablo
If t <> "" Then d(t) = t
Next
Application.ScreenUpdating = False
[3:65536].ClearContents
If d.Count < 2 Then Exit Sub
[A2].Resize(d.Count) = Application.Transpose(d.Keys)
[B3].Formula = "=VLOOKUP(A3,base!B$4:C$5000,2,0)"
[C3].Formula = "=SUMIF(base!B$4:B$5000,A3,base!D$4:D$5000)"
[D3].Formula = "=SUMIF(base!B$4:B$5000,A3,base!F$4:F$5000)"
[E3].Formula = "=D3/C3"
[F3].FormulaArray = "=MIN(IF(base!B$4:B$5000=A3,base!E$4:E$5000))"
[G3].FormulaArray = "=MAX((base!B$4:B$5000=A3)*base!E$4:E$5000)"
[H3].Formula = "=(F3-G3)/F3"
If d.Count > 2 Then [B3:H3].AutoFill [B3:H3].Resize(d.Count - 1)
'---si l'on veut ne conserver que les valeurs---
'[B3:H3].Resize(d.Count - 1) = [B3:H3].Resize(d.Count - 1).Value
End Sub