Améliorer une macro pour chercher des doublons

Bonjour à ceux qui me liront,

J'ai fait une petite macro pour rechercher les doublons. (voir ci-dessous). (je recherche, mets en vert et copie dans la cellule à droite.

Je pense qu'il est possible d'améliorer la vitesse de la macro mais je ne sais pas par où commencer.

Certains auraient-ils des idées?

Merci d'avance.

Sub Doublon_Vert()

'
' insertandrenamesheet Macro
'
Dim nvonglet As String

Dim comp1 As String
Dim comp2 As String

nb_line = ActiveSheet.Range("J65536").End(xlUp).Row

For I = 1 To nb_line
    For J = I + 1 To nb_line
        If (ActiveSheet.Cells(I, 10) = ActiveSheet.Cells(J, 10)) Then
            ActiveSheet.Cells(I, 10).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65280
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Selection.Copy
            ActiveSheet.Cells(I, 11).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False

            ActiveSheet.Cells(J, 10).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65280
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Selection.Copy
            ActiveSheet.Cells(J, 11).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False

   ' MsgBox ("i = " & i & "j = " & J)
        End If
    Next J
Next I

End Sub

Bonjour,

proposition d'amélioration

Sub Doublon_Vert()

'
' insertandrenamesheet Macro
'
    Dim nvonglet As String

    Dim comp1 As String
    Dim comp2 As String
    Application.ScreenUpdating = False
    nb_line = ActiveSheet.Range("J65536").End(xlUp).Row

    For I = 1 To nb_line
        For J = I + 1 To nb_line
            If (ActiveSheet.Cells(I, 10) = ActiveSheet.Cells(J, 10)) Then
                With ActiveSheet.Cells(I, 10)
                    With .Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 65280
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    .Copy
                    ActiveSheet.Cells(I, 11).PasteSpecial Paste:=xlPasteValues
                End With
                With ActiveSheet.Cells(J, 10)
                    With .Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 65280
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    .Copy
                    ActiveSheet.Cells(J, 11).PasteSpecial Paste:=xlPasteValues
                End With

                ' MsgBox ("i = " & i & "j = " & J)
            End If
        Next J
    Next I
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub