Salut Amayas,
un double-clic dans la feuille 'BDD' démarre la macro.
A tester en situation réelle...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, lgPos&, lgPos1&, dbTot#, sItem$
'
Application.ScreenUpdating = False
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
iCol = Cells(1, Columns.Count).End(xlToLeft).Column
Range("A1").Resize(iRow, iCol).Sort key1:=Range("A2"), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
tTab = Range("A1").Resize(iRow + 1, iCol).Value
'
lgPos = 3
lgPos1 = 2
sItem = tTab(2, 1)
Do
If tTab(lgPos, 1) = sItem Then tTab(lgPos - 1, 1) = ""
If tTab(lgPos, 1) <> sItem Then
dbTot = 0
For x = lgPos1 To lgPos - 1
dbTot = dbTot + CDbl(tTab(x, UBound(tTab, 2)))
Next
tTab(lgPos - 1, UBound(tTab, 2)) = dbTot
lgPos1 = lgPos
sItem = tTab(lgPos, 1)
End If
lgPos = lgPos + 1
Loop Until lgPos > UBound(tTab, 1)
'
With Worksheets("Extract")
.Range("A1").Resize(iRow, iCol).Value = tTab
.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlUp
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Range("A1").Resize(1, iCol).Interior.ColorIndex = 15
.Columns.AutoFit
.Activate
End With
'
Application.ScreenUpdating = True
'
End Sub
A+