Sub SousTotaux()
Dim n%, a()
With Feuil1 'CodeName
n = Application.CountA(.[A:A]) - 2 'nombre de fruits
ReDim a(1 To n) 'base 1
For n = 1 To n
a(n) = n + 2
Next
Application.ScreenUpdating = False
Feuil2.Cells.Delete 'RAZ
.[A1].CurrentRegion.Copy
With Feuil2 'CodeName
.Activate
.[A1].PasteSpecial xlPasteAll, Transpose:=True
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=a _
, Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.[A1].Select
.UsedRange.Borders.Weight = xlThin 'pour compléter les bordures
.UsedRange.Copy
End With
.[A1].PasteSpecial xlPasteAll, Transpose:=True
Application.CutCopyMode = False
.Activate
.[A1].Select
End With
End Sub