Sub TotalTest()
Dim f1, f2 As Worksheet
  Set f1 = Worksheets("données")
  Set f2 = Worksheets("synthese")
 
' Feuille "données"
    lignefin = f1.Range("e65535").End(xlUp).Row
    ausmassfin = f1.Range("AAA3").End(xlToLeft).Column - 6
    colonnechapitre = 2
    finrecap = ausmassfin
    a = f1.Range(Cells(3, colonnechapitre).Address & ":" & Cells(lignefin, finrecap).Address)
 
    nbraussmass = 0
  Set d1 = CreateObject("Scripting.Dictionary"): j = 1
  Set d2 = CreateObject("Scripting.Dictionary"): jj = 1
  Set d3 = CreateObject("Scripting.Dictionary")
 
  'remplir d1 liste verticale
  For i = LBound(a, 1) + 6 To UBound(a, 1)
    If a(i, 9) = "x" Then
        For Z = LBound(a, 2) + 16 To UBound(a, 2) Step 4
            If Not d1.exists(a(i, Z)) And a(i, Z) Like "NT*" Then j = j + 1: d1.Add Key:=a(i, Z), Item:=a(i, Z) & "|" & j
            If Not d2.exists(a(1, Z - 2)) Then jj = jj + 1: d2.Add Key:=a(1, Z - 2), Item:=a(1, Z - 2) & "|" & jj
            If Not d3.exists(Z) Then nbraussmass = nbraussmass + 1: d3(Z) = nbraussmass
        Next Z
    End If
  Next i
 
  'definir taille b
  nbraussmass = d3.Count + 2
  Dim b(): ReDim b(1 To d1.Count + 2, 1 To nbraussmass)
  Clefd1 = d1.keys                 'Get the keys
  Clefd2 = d2.keys                 'Get the keys
 
  ' 2) Tri du tableau
For i = LBound(Clefd2) To UBound(Clefd2) - 1
    For j = i + 1 To UBound(Clefd2)
        If Clefd2(i) > Clefd2(j) Then
            OrdreTemporaire = Clefd2(j)
            Clefd2(j) = Clefd2(i)
            Clefd2(i) = OrdreTemporaire
        End If
    Next j
Next i
For i = LBound(Clefd1) To UBound(Clefd1) - 1
    For j = i + 1 To UBound(Clefd1)
        If Clefd1(i) > Clefd1(j) Then
            OrdreTemporaire = Clefd1(j)
            Clefd1(j) = Clefd1(i)
            Clefd1(i) = OrdreTemporaire
        End If
    Next j
Next i
  For i = LBound(b, 1) + 1 To UBound(b, 1) - 1
    For j = LBound(b, 2) + 1 To UBound(b, 2) - 1
        b(i, 1) = Clefd1(i - 2)
        b(1, j) = Clefd2(j - 2)
    Next j
 Next i
  
  'remplir b
  For ligne = LBound(a, 1) + 7 To UBound(a, 1)
    If a(ligne, 9) = "x" Then
        For Colonne = LBound(a, 1) + 16 To UBound(a, 2) Step 4
            If a(ligne, Colonne) Like "NT*" Then
                p = d1.Item(a(ligne, Colonne))
                Lg = CInt(Split(p, "|")(1))
                    For v = LBound(b, 2) + 1 To UBound(b, 2) - 1
                        If b(1, v) = a(1, Colonne - 2) Then
                            b(Lg, v) = b(Lg, v) + a(ligne, Colonne - 1)
                            b(UBound(b, 1), v) = b(UBound(b, 1), v) + b(Lg, v)
                            b(Lg, UBound(b, 2)) = b(UBound(b, 2), v) + b(Lg, v)
                            Exit For
                        End If
                    Next v
            End If
     Next Colonne
  End If
  Next ligne
  'positionner le tableau
  f2.[a15].Resize(UBound(b, 1), UBound(b, 2)) = b
End Sub