Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Suppression de doublons dans une colonne sur XX onglets

zek

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
Bonjour Zek,
Sans modifier la structure de votre macro, remplacez
VB:
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.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Nouveau
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
 

Discussions similaires

Réponses
7
Affichages
327
Réponses
6
Affichages
140
Réponses
2
Affichages
117
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…