Salut StevenM,
Salut Xorsankukai
quelque chose comme ça?
Un double-clic démarre la macro...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim lgRow&, lgRowA&, lgRow1&, lgFact&
'
Cancel = True
Application.ScreenUpdating = False
'
lgRow1 = 2
lgRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:Z" & lgRow).Sort key1:=Range("I2"), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
With Worksheets("Extract")
.Cells.Delete
.Range("A1").Resize(1, 4).Value = Array("Site", "HTVA", "TVA", "TVAC")
For x = 2 To lgRow + 1
If lgFact <> CLng(Range("I" & x).Value) Then
lgFact = CLng(Range("I" & x).Value)
If x > 2 Then
lgRowA = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & lgRowA).Value = Range("E" & lgRow1).Value
For y = 15 To 17
.Range(Chr(51 + y) & lgRowA).Value = CDbl(WorksheetFunction.Sum(Range(Chr(64 + y) & lgRow1 & ":" & Chr(64 + y) & x - 1)))
Next
lgRow1 = x
End If
End If
Next
.Range("A1:D" & lgRowA).Borders.LineStyle = xlContinuous
.Range("A1:D1").Interior.ColorIndex = 15
.Columns.AutoFit
.Activate
End With
'
Application.ScreenUpdating = True
'
End Sub
A+