XL 2016 Suppression de doublons dans une colonne sur XX onglets

[zek]

Bonjour,

je dois filtrer une colonne (P) et supprimer les doublons dans cette colonne (sans supprimer les lignes)) dans XX onglets d'un même classeur.

j'étais parti sur la copie de cette colonne P, avec copie sur la colonne Q et filtrage doublon sur cette dernière (cela me permet de faire un contrôle

Sub filtre()

Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "DATA" Or ws.Name <> "mail" Then

Range("P1" & Range("P70000").End(xlUp).Row).Select
Selection.Copy

Range("Q1" & Range("P70000").End(xlUp).Row).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("Q:Q").RemoveDuplicates Columns:=1, Header:=xlYes
Range("Q1").Value = "mail unique"

End If
Next
End Sub

La macro se lance, mais ma colonne Q reste vide...sur tous les onglets concernés

ou me suis-je planté?

merci de votre aide.
Zek

 

[sylvanu]

Bonjour Zek,
Sans modifier la structure de votre macro, remplacez

Range("Q1" & Range("P70000").End(xlUp).Row).Select
par
Range("Q1").Select

le mieux est de faire du pas à pas pour suivre ce que fait le VBA, généralement cela permet de pointer la ligne erronée.

 

[zek]

Bonjour Zek,
Sans modifier la structure de votre macro, remplacez

Range("Q1" & Range("P70000").End(xlUp).Row).Select
par
Range("Q1").Select

le mieux est de faire du pas à pas pour suivre ce que fait le VBA, généralement cela permet de pointer la ligne erronée.

merci pour ce retour rapide, mais pas de changement

 

[sylvanu]

Alors c'est que je n'ai pas compris votre problème.
Voici ce que j'ai compris :
1- j'ai des données en colonne P
2- je les duplique en colonne Q
3- Je filtre les doublons sur la colonne Q.
Voir ci dessous le pas à pas. Où est mon erreur ?

 

[zek]

Bonjour,
j'ai reconstruis ma macro et cela fonctionne. Merci pour vous être penché dessus!

Cordialement

Zek

Sub suppression_doublon_VF()
Dim MonDico As Object
Dim c As Range
Dim fl As Worksheet


For Each fl In Worksheets
If fl.Name <> "DATA" And fl.Name <> "mail" Then

With fl
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In .Range("p2" & .Cells(.Rows.Count, 1).End(xlUp).Row)
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
.Range("Q2").resize(MonDico.Count, 1) = Application.Transpose(MonDico.keys)
.Range("Q2").resize(MonDico.Count, 1).Sort key1:=.Range("Q2"), Order1:=xlAscending, Header:=xlNo
.Range("P:Q").EntireColumn.AutoFit

Set MonDico = Nothing
End With
End If
Next fl
End Sub