S'il vous plait besoin d'aide, programme VBA

Sub CumulCredit()

    Dim DerLig As Long

    Dim AdressEmailTeste As String

    Dim Email As String

    Dim EmailMontant As Long

    Dim EmailDuree As Long

    Dim AdressOrigine As String

    Dim XMontant As Long

    Dim XDuree As Long    

    Application.ScreenUpdating = False

    [A2].Select    

    AdressEmailTeste = ActiveCell.Address

    AdressOrigine = ActiveCell.Address    

Debut:

RechercheSuivant:

    DerLig = Range("A1").End(xlDown).Row

    AdressEmailTeste = ActiveCell.Address

    Email = ActiveCell.Value

    If Email = "" Then Exit Sub

    EmailMontant = ActiveCell.Offset(0, 1).Value

    EmailDuree = ActiveCell.Offset(0, 2).Value        

    With Range("A" & ActiveCell.Row & ":A" & DerLig)

        Set X = .Find(Email, LookIn:=xlValues)

        If Not X Is Nothing Then

            X.Select

            If X.Address = Range(AdressEmailTeste).Address Then GoTo Origine

            XMontant = X.Offset(0, 1).Value

            XDuree = X.Offset(0, 2).Value

            If XDuree > EmailDuree Then

                X.Offset(0, 1).Value = XMontant + EmailMontant

                Range(AdressEmailTeste).Select

                Selection.EntireRow.Delete

                Range(AdressOrigine).Select

                GoTo Debut

            Else

                Range(AdressEmailTeste).Select

                ActiveCell.Offset(0, 1).Value = EmailMontant + XMontant

                Range(X.Address).EntireRow.Delete

                GoTo Debut

            End If

        Else

EmailSuivant:

        End If

    End With    

Origine:

    DerLig = Range("A1").End(xlDown).Row

    ActiveCell.Offset(1, 0).Select

    AdressOrigine = ActiveCell.Address

    GoTo Debut

End Sub