XL 2019 Repérage des doublons sous conditions

[ml121]

Bonjour,

*edit : Ajout d'un fichier exemple

Sur mon classeur, j'ai une liste de fiche avec des numéros de prix. En A un intitulé "N° de Prix" et en B le N° du prix.
L’espacement entre 2 lignes contenant le numéro de prix est variable.

Mon but est d'adapter le code suivant pour que a chaque fois qu'il repère dans la colonne A le texte "N° de prix" il stocke dans le dico la valeur de la colonne B correspondante...

voici le code que j'ai trouvé et essayer d'adapter sans réussite :

Sub test()

'Choix d'une couleur
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)
'Création d'un dictionnaire
Set mondico = CreateObject("Scripting.Dictionary")
'Compare chaque ligne avec le dico
For Each c In Range("A2", [A1000].End(xlUp))
If c.Value = 1 Then mondico.Item(c.Offset(0, 1).Value) = mondico.Item(c.Value) + 1
Next c
'Applique une couleur parmi le choix
For Each c In Range("C2", [C1000].End(xlUp))
If c.Value = 1 Then
nocoul = (Application.Match(c.Value, mondico.keys, 0)) Mod UBound(couleurs)
If mondico.Item(c.Value) > 1 Then c.Interior.ColorIndex = couleurs(nocoul)
End If
Next c
'Sélectionne cellule
Range("N2").Select
'Écrire la formule
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",COUNTIF(C[-1],RC[-1])&"" ""&""fois""&"" ""&RC[-1],"""")"
Selection.AutoFill Destination:=Range("B2:B1000") ', Type:=xlFillDefault
'Copie la formule dans la plage
Range("B2:B1000").Select
Range("D3").Select
'Range le curseur

End Sub