Fusionner des lignes selon deux critères

Bonjour à tous,

Je reviens vers vous afin de solliciter votre aide au sujet d’un problème auquel je ne trouve pas de solutions depuis un certain temps.

J’ai un code développé par un membre du forum qui fonctionne partiellement, il me permet de fusionner selon le critère à la colonne A et d’additionner les sommes à la colonne L sauf que j’aimerais rajouter une condition afin de ne fusionner les lignes uniquement si les critères à la colonne A et I sont identiques et qui reprend les données aux autres colonnes de la dernière ligne.

Vous trouverez ci-joint un fichier excel qui explique le mécanisme.

Le code que je détiens est le suivant :

Dim tTab, lgPos As Variant, lgPos1 As Variant, dbTot As Variant, sItem As Variant

Application.ScreenUpdating = False
iRow = Range("A" & Rows.Count).End(xlUp).Row
iCol = Cells(1, Columns.Count).End(xlToLeft).Column
Range("A1").Resize(iRow, iCol).Sort key1:=Range("A2"), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
tTab = Range("A1").Resize(iRow + 1, iCol).Value
lgPos = 3
lgPos1 = 2
sItem = tTab(2, 1)
Do
   If tTab(lgPos, 1) = sItem Then tTab(lgPos - 1, 1) = ""
    If tTab(lgPos, 1) <> sItem Then
        dbTot = 0
        For y = lgPos1 To lgPos - 1

        dbTot = dbTot + CDbl(tTab(y, UBound(tTab, 2)))

        Next
        tTab(lgPos - 1, UBound(tTab, 2)) = dbTot
        lgPos1 = lgPos
        sItem = tTab(lgPos, 1)
    End If
    lgPos = lgPos + 1
Loop Until lgPos > UBound(tTab, 1)
With Worksheets("Fusion de lignesl")
    .Range("A1").Resize(iRow, iCol).Value = tTab

    .Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp

    .Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
    .Range("A1").Resize(1, iCol).Interior.ColorIndex = 15
    .Columns.AutoFit
    .Activate
End With

En vous remerciant par avance.

AMAYAS