[Réglé] TRI somme autre feuille

Sub tri2()
Dim DerLig As Long, Compt As Long, i As Long, Qte As Integer
Dim Ligne As String, LignePrec As String

With Worksheets("Feuil1")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row

For i = DerLig To 2 Step -1
    Ligne = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3)
    LignePrec = .Cells(i - 1, 1) & .Cells(i - 1, 2) & .Cells(i - 1, 3)
    If Ligne = LignePrec Then
        Qte = Qte + .Cells(i, 4)
        Rows(i).Delete
    Else
        .Cells(i, 4) = .Cells(i, 4) + Qte
        Qte = 0
    End If
Next
End With

End Sub

Sub copiedefeuille3versfeuille1()
Dim DerLig As Long

    DerLig = Worksheets("Feuil3").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Feuil3").Select
    Range("A1:D" & DerLig).Select
    Selection.Copy
    Sheets("Feuil1").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub

Sub Transfert()
Dim DerLig As Long,  i As Long,  j As Long


j = 2
Worksheets("Feuil2").Activate
With Worksheets("Feuil1")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To DerLig
    If .Cells(i, 2).Value <> .Cells(i - 1, 2).Value Then
        Cells(j, 1).Value = .Cells(i, 2).Value
        With Range(Cells(j, 1), Cells(j, 3))
            .Interior.ColorIndex = 19
            .Font.Name = "Arial"
            .Font.Size = 16
        End With
        j = j + 1
    End If
    
    Cells(j, 1).Value = .Cells(i, 1).Value
    Cells(j, 2).Value = .Cells(i, 3).Value
    Cells(j, 3).Value = .Cells(i, 4).Value

    With Range(Cells(j, 1), Cells(j, 3))
        .Font.Name = "Arial"
        .Font.Size = 16
    End With
    j = j + 1
Next
End With

End Sub