Supprimer Doublons dans plusieurs feuilles

chandler282

XLDnaute Nouveau
Bonjour à tous, je suis nouveau ici et j'aurais vraiment besoin d'une aide sur une macro ...

J'ai un fichier excel avec 3 feuilles dans lesquelles apparaissent des listes misent à jour chaque semaine.

En effet ce que je cherche à faire, c'est supprimer les doublons présents dans ces 3 feuilles Excel. Mon code fonctionne pour chaque feuille indépendament les unes des autres mais pas les unes par rapport aux autres. (en gros il regarde dans chaque feuille et supprime pour chacune d'entre elles les doublons présents dans ces mêmes feuilles mais sans aller regarder ce qui se trouve dna sles suivantes)

Cependant, mon fichier va s'actualiser au fur et à mesure avec des dossiers qui vont passer du stade 1 au stade 2 puis au stade 3, et d'autres qui vont se retrouver 2 fois dans chaque stade, et avec donc des doublons puisque chaque semaine sera réactualisé l'ensemble de la liste par copié/collé (celui-ci étant issu d'une requête externe)

Mon but, c'est par exemple : qu'un dossier déjà présent en stade 1 et qui est rajouté la semaine suivante dans ce même stade soit effacé (je parle bien de la nouvelle entrée) et que pour un autre dossier déjà présent au stade 1 et qui a évolué en stade 2 en semaine suivante soit effacé du stade 1 lors de la mise à jour ... Il faut cependant que ce soit dans cet ordre (stade 1 --> Stade 2 --> Stade 3) avec éffacement du stade 1 après incrémentation dans le stade 2 ou 3 mais pas l'inverse et ainsi de suite ...

En gros dans le fichier Stade 1, on vérifie les doublons par rapport aux stades 1, 2 et 3. Pour le Stade 2, on vérifie les doublons par rapport aux stades 2 et 3. Et pour le 3 par rapport au stade 3 seulement.

J'éspère avoir été assez clair dans mon explication et que vous serez à même de m'aider dans ma prise de tête ... :)

Merci d'avance ;)

P.S : Pour info voici le code :

Sub SupprimeDoublonsStade1()
Dim Plage As Range, Cell As Range
Dim Un As Collection
Dim Tableau() As Long
Dim x As Integer


Set Un = New Collection

Set Plage = Worksheets("Stade 1").Range("B2:B500")

For Each Cell In Plage
On Error Resume Next
'Alimente la collection de données sans doublons.
Un.Add Cell, CStr(Cell)

'Une erreur survient si l'élément existe dans la collection.
'La procédure enregistre le numéro de ligne correspondant dans un tableau.
If Err.Number <> 0 Then
x = x + 1
ReDim Preserve Tableau(x)
Tableau(x) = Cell.Row
End If
Next Cell


'On sort de la procédure s'il n'y a pas de doublons.
If x = 0 Then Exit Sub

'Permet de figer l'écran pendant la suppression des lignes.
Application.ScreenUpdating = False

'boucle sur le tableau pour supprimer les lignes contenant les doublons.
For x = UBound(Tableau) To LBound(Tableau) Step -1
Worksheets("Stade 1").Rows(Tableau(x)).EntireRow.Delete
Next x

Application.ScreenUpdating = True
MsgBox "Terminé."

Set Un = Nothing
End Sub
 

Pièces jointes

  • STOCKS DOSSIERS.zip
    14.3 KB · Affichages: 80
  • STOCKS DOSSIERS.zip
    14.3 KB · Affichages: 82
  • STOCKS DOSSIERS.zip
    14.3 KB · Affichages: 88

chandler282

XLDnaute Nouveau
Re : Supprimer Doublons dans plusieurs feuilles

Petit complément d'information : :)

Dans le fichier joint (qui normalement fonctionne) il suffit de copier les lignes existantes dans la feuille "Stade 1" et de les coller en dessous et les nouvelles entrées doivent disparaitre en cliquant sur la macro ...

Le tri de doublons est effectué sur la colonne B ...

Vraiment merci d'avance pour votre aide et n'hésitez pas à me poser des questions en cas de doute ou de problème ... :)
 

chandler282

XLDnaute Nouveau
Re : Supprimer Doublons dans plusieurs feuilles

Heeeelp ... S'il vous plait pouvez-vous m 'aider ? :(

J'ai cherché toute sorte de lignes de codes, j'ai parcouru tous les forums et tous les posts un peu partout mais rien ne semble coller ni fonctionner ...

Vraiment merci d'avance
 

chandler282

XLDnaute Nouveau
Re : Supprimer Doublons dans plusieurs feuilles

Bonjour Mathieu33 :) et merci beaucoup pour ta réponse ...

Cependant il m'affiche une erreur ...

Je me permet donc de renvoyer un nouveau fichier avec plus d'explications et surtout une démo de ce que je souhaiterai obtenir ...

En esperant que cela va t'aider ... à m'aider lol
A te lire de nouveau :)
 

Pièces jointes

  • STOCKS DOSSIERS.zip
    16.6 KB · Affichages: 69
  • STOCKS DOSSIERS.zip
    16.6 KB · Affichages: 73
  • STOCKS DOSSIERS.zip
    16.6 KB · Affichages: 65

chandler282

XLDnaute Nouveau
Re : Supprimer Doublons dans plusieurs feuilles

Banzai64 je ne sais pas exactement comment tu as réussis ce tour de force mais cela semble fonctionner ... et même mieux que ce que j'aurais pu croire puisque l'idée de les faire un par un et de manière autonome ou automatique est vraiment une super idée ... :)

Je suis bluffé ... et te remercie énormément pour ton aide ...

Je vais de ce pas le confronter à la dure réalité des copier/collé et autres joyeusetés et je me permettrais de venir te tenir au courant ...

Encore merci :)



P.S : J'ai juste modifié un point ici

If Feuille2 <> "Fin" Then
Set Plage = Sheets(Feuille2).Range("B2:B500" & Range("B65536").End(xlUp).Row)
For Each Cell In Plage
On Error Resume Next

Et un peu en dessous aussi j'ai mis "B2:B500" au lieu de "B2:B" car il ne trouvait pas les doublons ... Je sais pas exactement pourquoi j'ai fais ça ... lol mais cela semble fonctionner ????!

Si tu pouvais m'expliquer d'ailleurs ce serait super

Bonne soirée
 

matthieu33

XLDnaute Occasionnel
Re : Supprimer Doublons dans plusieurs feuilles

re,

Je viens d'insérer la procédure que je t'avais transmise dans le précédent fichier et les doublons ont bien été supprimés.
La procédure se trouve dans les modules "Procedures" (Sub SupDoublon).

@+
 

Pièces jointes

  • STOCKS DOSSIERS_v2.zip
    19.7 KB · Affichages: 99

Discussions similaires

Réponses
10
Affichages
371

Membres actuellement en ligne

Statistiques des forums

Discussions
314 655
Messages
2 111 605
Membres
111 217
dernier inscrit
aladinkabeya2