Problème de dédoublonnage

[virgal]

Bonjour,

Il s'agit d'un problème concernant VBA
Sur ce fichier il y a plusieurs macros.
Là où j'ai un problème c'est sur la feuille CR_Sec_Annexe
Il y a une première macro qui récupère des codes et les afffiches en colonne B.
Mon but est d'avoir une liste sans doublons qui s'affiche à partir de la cellule B3.
Avec la fonction actuelle SuppressionDoublonsColonne cela m'affiche un message d'erreur "400".
Ma volonté derrière est d'avoir plusieurs duo de colonne type a et b.

Merci d'avance de votre aide

 

[pierrejean]

Re : Problème de dédoublonnage

bonjour virgal

et bienvenue sur XLD

Ta macro modifiée

Sub SuppressionDoublonColonne(NumCol As Integer)
Dim Cible As Range, Suivant As Range
Application.ScreenUpdating = False
With ActiveSheet.Cells
.Sort Key1:=.Cells(1, 2), Order1:=xlAscending
Set Cible = .Cells(1, 2)
Do
Set Suivant = Cible.Offset(1, 0)
If Suivant = Cible Then Cible.Delete xlUp
Set Cible = Suivant
Loop Until Cible = ""
End With
Application.ScreenUpdating = True
End Sub

 

[virgal]

Re : Problème de dédoublonnage

Merci pierrejean,

et quelle efficacité !

 

[virgal]

Re : Problème de dédoublonnage

Cette solution me permet de faire le doublonnage mais me créer des cellules dans ma colonne A.
C'est le même fichier mais utilisé avec des noms différents pour que la simulation fonctionne.

Je n'arrive pas à comprendre pourquoi cela créer une cellule alors qu'il n'y as pas de "Insert" de marquer.

Merci d'avance,

 

[virgal]

Re : Problème de dédoublonnage

Pour Info j'ai trouvé cette solution,

ActiveSheet.Columns(Col - 1).SpecialCells(xlCellTypeBlanks).Delete xlUp

Ce qui me donne comme code

Sub SuppressionDoublonColonne(Col As Integer)

Dim Cible As Range
Dim Suivant As Range

Application.ScreenUpdating = False
With ActiveSheet.Cells
.Sort Key1:=.Cells(1, Col), Order1:=xlAscending
Set Cible = .Cells(1, Col)
Do
Set Suivant = Cible.Offset(1, 0)
If Suivant = Cible Then Cible.Delete xlShiftUp
Set Cible = Suivant
Loop Until Cible = ""
End With

ActiveSheet.Columns(Col - 1).SpecialCells(xlCellTypeBlanks).Delete xlUp

Application.ScreenUpdating = True
End Sub

 

[pierrejean]

Re : Problème de dédoublonnage

Re

Si cette solution te convient c'est parfait
sinon il faudrait reexpliquer ce que tu souhaites comme resultat (avec exemple sur quelques lignes)