Filtré, trier et additionner / VBA

Bonjour à vous !

Je suis un peu embêté je n'arrive pas à trouver la solution ;

J’ai un fichier qui contiens les feuillets suivante ;

• Liste des Retenues ;
• Liste à envoyer

Mon bute ci de remplir la liste à envoyer à partir de la liste des retenues tout en prenant en considération les conditions suivante :

• Si le travailleur à solder sont prêt alors il ne doit pas figurer sur la liste à envoyer (voir la colonne N = Remboursé), dans mon exp Philippe Roy et Jean Moreno en remboursé leur prêt alors il ne figure pas.
• Si il Ya un travailleur qui a un double prêt ou un triple ou plus, dans la liste à envoyer il ne doit apparaitre qu’une seul fois tout en additionnant les montants des Échéances (colonne M), dans mon exp Patricia Foucher à deux prêt, alors dans la liste à envoyer elle ne figure qu’une seul fois mais le montant a débité est l’addition des deux Échéance (colonne M).

Voir la solution souhaitée ci joint avec le fichier

Nb : SVP en code VBA.

Merci beaucoup d'avance.

Salut qoui de neuf

Bonjour,

Essayez ceci

Cdlt

edit:

Je me suis trompé de colonne des montants, rectificatif:

Bonjour

Bonjour à tous

Une variante :

Option Explicit

Dim f As Worksheet, tablo, tabloR(), dico As Object, dico2 As Object, dico3 As Object
Dim i&, l&, k&, iR&

Private Sub Worksheet_Activate()

    Range("A15:E" & Application.Max(15, Range("E" & Rows.Count).End(xlUp).Row)).ClearContents
    Set f = Sheets("Liste des Retenues")
    tablo = f.Range("A1").CurrentRegion
    ReDim tabloR(1 To UBound(tablo, 1), 1 To 4)
    Set dico = CreateObject("Scripting.Dictionary")
    Set dico2 = CreateObject("Scripting.Dictionary")
    Set dico3 = CreateObject("Scripting.Dictionary")

    k = 0
    For i = 2 To UBound(tablo, 1)
        If tablo(i, 14) <> "Remboursé" Then
            If Not dico.exists(tablo(i, 3)) Then
                dico(tablo(i, 3)) = tablo(i, 13)
                dico2(tablo(i, 3)) = tablo(i, 4)
                dico3(tablo(i, 3)) = tablo(i, 5)
            Else
                dico(tablo(i, 3)) = dico(tablo(i, 3)) + tablo(i, 13)
            End If
        End If
    Next i

    Range("B15").Resize(dico.Count, 1) = Application.Transpose(dico.keys)
    Range("C15").Resize(dico.Count, 1) = Application.Transpose(dico2.items)
    Range("D15").Resize(dico.Count, 1) = Application.Transpose(dico3.items)
    Range("E15").Resize(dico.Count, 1) = Application.Transpose(dico.items)
    Range("B15:E" & Range("B" & Rows.Count).End(xlUp).Row).Sort key1:=Range("B15"), order1:=xlAscending, _
                Header:=xlNo
    Range("A15") = 1
    Range("A15:A" & 14 + dico.Count).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
        Step:=1, Trend:=False
    Range("E" & 15 + dico.Count).FormulaR1C1 = "=SUM(R[-" & dico.Count & "]C:R[-1]C)"
    Range("D" & 15 + dico.Count).FormulaR1C1 = "TOTAL"
End Sub

Bye !

bonjour et merci a vous gmb et Arturo83, ça marche trés bien

a plus.