Option Explicit
Sub Fusion()
Dim dico As Object, ws As Worksheet, txt As String, i As Long, a, w
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
For Each ws In Worksheets
If ws.Name <> "Annuel" Then
a = ws.Cells(1).CurrentRegion.Value
For i = 2 To UBound(a, 1)
txt = Join$(Array(a(i, 1), a(i, 3)))
If Not dico.exists(txt) Then
ReDim w(1 To 3)
w(1) = a(i, 1)
w(2) = a(i, 3)
dico(txt) = w
End If
w = dico(txt)
w(3) = w(3) + Val(a(i, 2))
dico(txt) = w
Next
End If
Next
'Restitution et mise en forme
Application.ScreenUpdating = False
With Sheets("Annuel").Cells(1)
.CurrentRegion.Clear
.Resize(, 3).Value = [{"Produits","Lieu","Quantité"}]
.Offset(1).Resize(dico.Count, 3).Value = _
Application.Transpose(Application.Transpose(dico.items))
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
With .Rows(1)
.Font.Size = 11
.Interior.ColorIndex = 38
.BorderAround Weight:=xlThin
End With
End With
End With
Application.ScreenUpdating = True
End Sub