macro extraction données et soustraction

Sub Calculer_Masse()
Application.ScreenUpdating = False
Dim tablo, coll As Collection
Set coll = New Collection
ReDim tablo(2, 1)
With Sheets("testmacro2")
For n = 12 To .Range("A65536").End(xlUp).Row
  On Error Resume Next
   coll.Add .Range("A" & n), CStr(.Range("A" & n))
  On Error GoTo 0
Next n
For n = 1 To coll.Count
  For m = 12 To .Range("A65536").End(xlUp).Row
    If .Range("A" & m) = coll(n) Then masse = .Range("C" & m) - masse
  Next m
  If masse > 0 Then masse = ""
  'If masse > 0 Then masse = -masse
  tablo(1, n) = coll(n)
  tablo(2, n) = masse
  ReDim Preserve tablo(2, UBound(tablo, 2) + 1)
  masse = 0
Next n
ligne = 1
For n = 1 To UBound(tablo, 2) - 1
  Sheets("Feuil2").Cells(ligne, 1) = tablo(1, n)
  Sheets("Feuil2").Cells(ligne, 2) = tablo(2, n)
  ligne = ligne + 1
Next n
End With
Application.ScreenUpdating = True
End Sub

Option Base 1

Sub Calculer_Difference_Masse()
'Calcul la différence entre la dernière et avant dernière occurence trouvée
Application.ScreenUpdating = False
Dim tablo, coll As Collection
Set coll = New Collection
ReDim tablo(2, 1)
With Sheets("testmacro2")
  For n = 12 To .Range("A65536").End(xlUp).Row
    On Error Resume Next
      coll.Add .Range("A" & n), CStr(.Range("A" & n))
    On Error GoTo 0
  Next n
  For n = 1 To coll.Count
    For m = 12 To .Range("A65536").End(xlUp).Row
      If .Range("A" & m) = coll(n) Then
        masse2 = masse1
        masse1 = .Range("C" & m)
        difference = masse1 - masse2
      End If
    Next m
    If difference > 0 Then difference = ""
    tablo(1, n) = coll(n)
    tablo(2, n) = difference
    ReDim Preserve tablo(2, UBound(tablo, 2) + 1)
    difference = 0: masse1 = 0: masse2 = 0
  Next n
End With
With Sheets("Feuil2")
  ligne = 1
  For n = 1 To UBound(tablo, 2) - 1
    .Cells(ligne, 1) = tablo(1, n)
    .Cells(ligne, 2) = tablo(2, n)
  ligne = ligne + 1
  Next n
End With
Application.ScreenUpdating = True
End Sub

Option Base 1

Sub Calculer_Difference_Masse()
'Calcul la différence entre la dernière et première occurence trouvée
Application.ScreenUpdating = False
Dim tablo, coll As Collection
Set coll = New Collection
ReDim tablo(2, 1)
With Sheets("testmacro2")
  DerLiS = .Range("A65536").End(xlUp).Row
  'DerLiS =.Range("A" & Rows.Count).End(xlUp).Row
   Set plage = .Range("A12:A" & DerLiS)
  For n = 12 To DerLiS
    On Error Resume Next
      coll.Add .Range("A" & n), CStr(.Range("A" & n))
    On Error GoTo 0
  Next n
  For n = 1 To coll.Count
    masse2 = plage.Find(coll(n), .Range("A" & DerLiS), , , xlByRows, xlNext).Offset(0, 2).Value
    masse1 = plage.Find(coll(n), , , , xlByRows, xlPrevious).Offset(0, 2).Value
    x = plage.Find(coll(n), .Range("A" & DerLiS), , , xlByRows, xlNext).Row
    y = plage.Find(coll(n), , , , xlByRows, xlPrevious).Row
    difference = masse1 - masse2
    If x = y Then difference = ""
   'If x = y Then difference = masse2
     tablo(1, n) = coll(n)
    tablo(2, n) = difference
    ReDim Preserve tablo(2, UBound(tablo, 2) + 1)
    difference = 0: masse1 = 0: masse2 = 0
  Next n
End With
On Error Resume Next  'au cas où
  Sheets("Feuil2").Range("a1").Resize(UBound(tablo, 2) - 1, 2) = Application.Transpose(tablo)
On Error GoTo 0
'Cette instruction équivaut au bloc ci-dessous
'With Sheets("Feuil2")
'  ligne = 1
'  For n = 1 To UBound(tablo, 2) - 1
'    .Cells(ligne, 1) = tablo(1, n)
'    .Cells(ligne, 2) = tablo(2, n)
'  ligne = ligne + 1
'  Next n
'End With
Application.ScreenUpdating = True
End Sub