Re-
J'ai résolu tout mes soucis grâce à tes conseils. Encore merci pour ton temps Eric.
Voici le code final si il y as des intéressé.
Private Sub Suppression_des_doublons2()
Dim Ws1 As Worksheet
Dim I, J, dl, dl2 As Long
With Application
.Calculation = xlManual
.ScreenUpdating = False
End With
Set Ws1 = Sheets("Extrapolation")
With Ws1
dl = .Cells(.Rows.Count, "E").End(xlUp).Row
For I = dl To 6 Step -1
If "'" & .Cells(I, "E") = "'" & .Cells(I - 1, "E") Then
.Cells(I - 1, "F").Delete
.Cells(I - 1, "E").Delete
.Cells(I - 1, "D").Delete
'Debug.Print I & " : " & Range("E" & I)
'.Cells(I, "E").Interior.Color = RGB(255, 255, 0)
End If
Next I
dl2 = .Cells(.Rows.Count, "B").End(xlUp).Row
For J = dl2 To 6 Step -1
If "'" & .Cells(J, "B") = "'" & .Cells(J - 1, "B") Then
.Cells(J - 1, "C").Delete
.Cells(J - 1, "B").Delete
.Cells(J - 1, "A").Delete
'Debug.Print I & " : " & Range("E" & I)
'.Cells(I, "E").Interior.Color = RGB(255, 255, 0)
End If
Next J
End With
Set Ws1 = Nothing
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub