VBA créer liste sans doublon

Bonjour,

Je me permets de vous solliciter car je ne trouve pas de solution viable à mon problème.

J'ai un tableau avec des références d'articles en colonne A, dans lequel plusieurs lignes peuvent être associées à une seule référence (on peut retrouver la même référence en ligne 3, 5, 9... car différents clients pour ce produit).

Je souhaite créer une macro qui permette dans une nouvelle feuille de calcul de faire la liste de ces références sans doublon (une référence est associée à une seule ligne).

Vous trouverez ci-joint un document type pour que vous compreniez mieux.

Voici la macro à laquelle j'avais pensé :

Sub Pominformations()

Dim LineC, LineP, Lastrow As Integer

LineC = 2
LineP = 2

Worksheets("Pom informations").Cells(LineP, 1) = Worksheets("Common Parts").Cells(2, 1)

Lastrow = Worksheets("Common Parts").Range("A2").End(xlDown).Row

For LineC = 2 To Lastrow
If Worksheets("Common Parts").Cells(LineC + 1, 1) <> Worksheets("Common Parts").Range(Cells(2, 1), Cells(LineC, 1)) Then 'Si la référence en ligne C est différente des réferences précédentes

Worksheets("Pom informations").Cells(LineP + 1, 1) = Worksheets("common Parts").Cells(LineC + 1, 1) 'Alors on l'ajoute à la liste
LineP = LineP + 1
End If
Next LineC

End Sub

Or, la ligne en rouge ne fonctionne pas. J'imagine que c'est parce-que l'on ne peut pas comparer une cellule à une plage de cellule.

J'ai tenté de trouver une autre solution via le forum et les sites internet mais je n'y parviens pas..

Si vous auriez une piste de réflexion à me donner se serait super !

En vous remerciant par avance !

Bonjour

Sans fichier ... essayez ceci

Sub test() 'liste sans doublons
Dim Tablo As Collection
Dim cel As Range
Dim LineP As Integer
Dim Item

With Sheets("Common Parts")
    Set Tablo = New Collection
    On Error Resume Next
        For Each cel In .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
            Tablo.Add cel.Value, CStr(cel.Value)
        Next cel
    On Error GoTo 0
    LineP = 2
    For Each Item In Tablo
        Worksheets("Pom informations").Range("A" & LineP) = Item
        LineP = LineP + 1
    Next Item
End With
End Sub

Cordialement

Edit : Ou peut être plus simple comme ceci

Sub test()
With wotkSheets("Common Parts")
    .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy Worksheets("Pom informations").Range("A2")
End With
With Worksheets("Pom informations")
    .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
End With
End Sub

J'étais persuadé d'avoir insérer le fichier exemple en pièce jointe...

Cependant votre code fonctionne parfaitement !

Je vous remercie beaucoup, vous me faites gagner un temps précieux.

Bonne journée

Cordialement