Private Sub Worksheet_Activate()
Dim a, annee1, annee2, d1 As Object, d2 As Object, d3 As Object, d4 As Object, i%, derlig&, j&, v1#, v2#, v3#, v4#, x$
a = Array("BP", "BCP", "CDN") 'feuilles à consolider
annee1 = [E3]: annee2 = [G3]
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
Set d4 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
d2.CompareMode = vbTextCompare
d3.CompareMode = vbTextCompare
d4.CompareMode = vbTextCompare
For i = 0 To UBound(a)
With Sheets(a(i))
derlig = .Range("E" & .Rows.Count).End(xlUp).Row
For j = 6 To derlig
If IsDate(.Cells(j, 2)) Then 'sécutité
v1 = 0: v2 = 0: v3 = 0: v4 = 0
If IsNumeric(.Cells(j, 7)) Then 'sécurité
If Year(.Cells(j, 2)) = annee1 Then
If .Cells(j, 7) > 0 Then v1 = .Cells(j, 7) Else v2 = .Cells(j, 7)
ElseIf Year(.Cells(j, 2)) = annee2 Then
If .Cells(j, 7) > 0 Then v3 = .Cells(j, 7) Else v4 = .Cells(j, 7)
End If
End If
x = .Cells(j, 5) & Chr(1) & .Cells(j, 6)
d1(x) = d1(x) + v1: d2(x) = d2(x) + v2
d3(x) = d3(x) + v3: d4(x) = d4(x) + v4
End If
Next j
End With
Next i
Application.ScreenUpdating = False
Range("C5:H" & Rows.Count).ClearContents
If d1.Count = 0 Then Exit Sub 'sécurité
[C5].Resize(d1.Count) = Application.Transpose(d1.keys) 'Transpose est limitée à 65536 lignes
[C5].Resize(d1.Count).TextToColumns [C5], xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
[E5].Resize(d1.Count) = Application.Transpose(d1.items)
[F5].Resize(d2.Count) = Application.Transpose(d2.items)
[G5].Resize(d3.Count) = Application.Transpose(d3.items)
[H5].Resize(d4.Count) = Application.Transpose(d4.items)
[C5].Resize(d1.Count, 6).Sort [C5], xlAscending, [D5], Header:=xlNo 'tri
Columns("C:H").AutoFit 'ajustement largeur
End Sub