Transfert de donnees aleaoires et additions

Bonjour, voici mon problème.

Sur un onglet (Feuil1) , j'ai une multitude de données ... Pour l'exemple, (en fichier joint) j'ai du couper la longueur, qui est normalement de 35000 lignes..

Je voudrais réaliser une macro qui :

Si dans ma colonne "C" , le numéro de fabrication est le même sur plusieurs lignes, additionner (colonne O) les quantités liées a ce numéro de fabrication. Puis le transférer en ligne sur ma feuille 2 (Calculé)

Si dans ma colonne "C" le numéro de fabrication est unique, faire la même chose.

Dans le fichier joint, j'ai réalisé ce que je voudrais, (sans code) en faisant simplement une addition de cellule.

Si quelqu'un à un solution à me donner , ce serai vraiment génial, car je suis sur le sujet depuis jeudi dernier, mais sans réussite ...

Merci d'avance, =)

bonjour

avec un TCD (sans aucune formule)

ou bien avec des SOMMEPROD, mais il faut saisir les conditions

Bonjour Jess,

Bonjour jmd,

parce que je suis un vieux dinosaure qui apprécie toujours son papier et son crayon... et qui ne pourrait pas faire autrement, de toute façon!

Private Sub cmdGO_Click()
'
Dim tTabO, tTabF()
'
iRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:O" & iRow).Sort key1:=Range("A2"), order1:=xlAscending
tTabO = Range("A2:O" & iRow)
'
For x = 1 To UBound(tTabO, 1)
    If tTabO(x, 1) <> sFlag Then
        sFlag = tTabO(x, 1)
        iIdx = iIdx + 1
        ReDim Preserve tTabF(4, iIdx)
        tTabF(0, iIdx - 1) = tTabO(x, 1)
        tTabF(1, iIdx - 1) = tTabO(x, 2)
        tTabF(2, iIdx - 1) = tTabO(x, 3)
        tTabF(3, iIdx - 1) = CDbl(tTabO(x, 15))
    Else
        tTabF(3, iIdx - 1) = tTabF(3, iIdx - 1) + CDbl(tTabO(x, 15))
    End If
Next
With Worksheets("Recap")
    .UsedRange.Delete
    .Range("A2:D" & iIdx + 1) = WorksheetFunction.Transpose(tTabF)
    iRow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(1, 1) = "Référence"
    .Cells(1, 2) = "Libellé"
    .Cells(1, 3) = "Fabrication"
    .Cells(1, 4) = "Quantité +"
    .Range("A1:D1").Interior.Color = RGB(215, 215, 215)
    .UsedRange.Borders.LineStyle = 1
    .Activate
End With
'
End Sub

Bon travail!

A+

Bonjour Curulis57,

Merci pour ta réponse, ça marche !!

Merci encore !

A la prochaine Mr le vieux dinosaure =)