Regrouper si valeur identique

[Francis200]

Bonjour,

J'ai réalisé un travail qui me permet d'identifier les cellules identiques et qui ne correspondent pas à ma condition afin de pouvoir regrouper les informations ensembles et les copier coller sur l'onglet suivant malheureusement je n'arrive pas à écrire la macro qui me permets d'additionner les données ensembles et les copier coller sur l'autre onglets. Est-ce qu'une personne saurait m'aider à finaliser ma macro ?

Je m'explique :
J'ai 2 onglets, un onglets avec les données et de l'autre un onglet où les données vont être transposées.

Si sur la colonne I, il y a marqué "Non Regrouper", s'il détecte cela, il ne fait que copier coller les données à la suite sur l'onglet suivant ("Feuil3")
Si sur la colonne A, il ne détecte pas de doublon ou cellule identique sur cette colonne A, il copie colle les données à la suite sur l'onglet suivant (Ma colonne G, permet de dire si la valeur de la ligne existe déjà dans la colonne)
Si sur la colonne A, s'il y a un doublon, alors il ne colle qu'une ligne sur l'autre onglet et fait la somme des valeurs de la colonne C et D seulement pour les valeurs qui sont identique à celles-ci (j'ai fait la somme de ces cellules sur Ma colonne J et K)

J'espère avoir été explicite sur mes explications.
Je vous ai mis le résultat attendu réalisé manuellement dans l'onglet Feuil3 afin que vous puissiez mieux comprendre mes explications

Je vous mets en PJ mon fichier.

Merci pour votre aide,

Francis200

 

[job75]

Bonjour Francis200,

Voyez le fichier joint et cette macro dans le code de la feuille "Résultat" :

Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, n&
With Sheets("Base") 'nom de la feuille à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A1].CurrentRegion
        .Sort .Cells(1), xlAscending, Header:=xlYes 'tri préalable
        tablo = .Resize(, 9) 'matrice, plus rapide
    End With
End With
ReDim resu(1 To UBound(tablo), 1 To 3) '3 colonnes
For i = 2 To UBound(tablo)
    If tablo(i, 9) <> "" Or tablo(i, 1) <> tablo(i - 1, 1) Then
        n = n + 1
        resu(n, 1) = tablo(i, 1)
    End If
    resu(n, 2) = resu(n, 2) + Val(Replace(tablo(i, 3), ",", "."))
    resu(n, 3) = resu(n, 3) + Val(Replace(tablo(i, 4), ",", "."))
Next
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

La macro se déclenche quand on active la feuille.

Il n'y aura pas de problème même s'il y a des textes à la place des nombres.

A+

 

[Francis200]

Salut Job75,

Je te remercie beaucoup pour ton aide, il marche parfaitement.

C'est top !!!

A+

Francis200