Mettre en surbrillance la ligne où j'ai un doublon

Bonjour,

Je cherche à mettre en surbrillance les lignes où se trouvent mes doublons (en colonne B).

J'ai enregistrer une macro pour pouvoir trouver mes doublons (je ne peux pas utilisé la mise en forme conditionnelle car la macro doit se réaliser dans une feuille créer par une autre macro), seulement je n'arrive pas à indiquer qu'il faut mettre en surbrillance toute ma ligne où se trouve mon doublon et non seulement la cellule où se trouve mon doublon.

Serait-il possible de m'aider ?

Je vous remercie, bonne soirée.

Agathe P.

Bonjour AgatheP, le forum,

Ceci pourrait t'aider....Doublons 2 critères

Ce qui pourrait donner ceci: (avec critère colonne A et B uniquement)

Sub DOUBLONS()
 Dim  couleurs

  couleurs = Array(1, 3, 4, 6, 7, 8, 14, 15, 17, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 50, 53)

  Set mondico = CreateObject("Scripting.Dictionary")
   With Sheets("Import_Climawin")
    For Each c In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
      clé = c.Value & c.Offset(, 1)   'valeur colonne A et B
       mondico.Item(clé) = mondico.Item(clé) + 1
    Next c
    For Each c In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
      clé = c.Value & c.Offset(, 1)
       nocoul = (Application.Match(clé, mondico.keys, 0)) Mod UBound(couleurs)
       If mondico.Item(clé) > 1 Then c.Resize(, 5).Interior.ColorIndex = couleurs(nocoul)
    Next c
   End With
End Sub

Uniquement les lignes strictement identiques:

Sub DOUBLONS()
 Dim  couleurs

  couleurs = Array(1, 3, 4, 6, 7, 8, 14, 15, 17, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 50, 53)

  Set mondico = CreateObject("Scripting.Dictionary")
   With Sheets("Import_Climawin")
    For Each c In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
      clé = c.Value & c.Offset(, 1) & c.Offset(, 2) & c.Offset(, 3) & c.Offset(, 4) 'valeur colonne A et B et C et D et E
       mondico.Item(clé) = mondico.Item(clé) + 1
    Next c
    For Each c In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
      clé = c.Value & c.Offset(, 1) & c.Offset(, 2) & c.Offset(, 3) & c.Offset(, 4)
       nocoul = (Application.Match(clé, mondico.keys, 0)) Mod UBound(couleurs)
       If mondico.Item(clé) > 1 Then c.Resize(, 5).Interior.ColorIndex = couleurs(nocoul)
    Next c
   End With
End Sub

Cordialement,

Bonjour xorsankukai,

Merci beaucoup, c'est encore mieux que ce que je voulais faire !

Bonne journée.

Agathe P.