Option Explicit
Sub Bouton1_QuandClic()
Dim ws As Worksheet
Dim tablo()
Dim data As Collection
Dim i As Integer
Dim j As Integer
Dim c As Range
Dim derligne As Integer
Dim x As Integer, l As Integer
Dim somme As Double
Set data = New Collection
x = 1
l = 2
ReDim tablo(1 To 6, 1 To x)
For Each ws In Worksheets
If ws.Name <> 'bilan' Then
With ws
derligne = .Range('a65536').End(xlUp).Row
For Each c In .Range('a2:a' & derligne)
If c <> '' Then
On Error Resume Next
data.Add CStr(c.Text), CStr(c.Text)
On Error GoTo 0
x = x + 1
ReDim Preserve tablo(1 To 6, 1 To x)
For i = 1 To 6
tablo(i, x) = .Cells(c.Row, i)
Next i
End If
Next c
End With
End If
Next ws
With Sheets('bilan')
For i = 1 To data.Count
For j = 1 To UBound(tablo, 2)
If data(i) = tablo(1, j) Then
somme = somme + tablo(5, j)
End If
Next j
.Cells(l, 7) = data(i)
.Cells(l, 8) = somme
somme = 0
l = l + 1
Next i
End With
End Sub