XL 2013 Copier les doublons dans un autre classeur

[louloubru]

Bonjour à tous,

j'ai un classeur contenant des contacts sur plusieurs feuilles (je sais, plusieurs feuilles ce n'est pas idéal amsi c'est comme ça...)

Je cherche à copier coller les doublons dans un autre classeur? J'ai déjà copier dans un autre classeur tous els contacts répondant à une certaine condition, cela fonctionne. J'ai donc repris le code en changeant la condition et utilisé la fonction countIf.
Cela ne fonctionne pas, j'ai l'erreur : "Objet requis" (sur la ligne que je désigne dans le code ci-dessous). Je cherche les doublons dans la colonne col que je définie juste avant dans la procédure (j'ai testé ça fonctionne).
Pourriez-vous me dire ce qui pose problème dans le code suivant : ?
Je soupçonne d'avoir mal défini "Plage" (toute la colonne col) mais je ne sais pas comment la définir autrement.

Sub doublon_feuille()

    'Trouver la colonne correspondant au prénom
    Dim col As Long
    col = Range(RefCell("Nom")).Column
    InitialiseNoms_feuilles 'Initialise un vecteur avec le noms des feuilles dans lesquelles je veux chercher mes doublons
    
    'Création d'un tableau contenant mes lignes
    Dim TabE()
    Dim Plage As Range
    Dim LE As Integer
    Dim TabS()
    Dim LS As Long
    LS = 0
    Dim c As Long
    c = 0
    Dim i As Long
    i = 0
    
    ReDim TabS(1 To 5000, 1 To 10)
    For i = LBound(Noms_feuilles) To UBound(Noms_feuilles)
    
        With Sheets(Noms_feuilles(i))
        TabE = .UsedRange.Value
        Set Plage = .Range(.Cells(2, col), .Cells(.Rows.Count, col).End(xlUp))
        End With
    
        If UBound(TabS, 2) < UBound(TabE, 2) Then ReDim Preserve TabS(1 To UBound(TabS, 1), 1 To UBound(TabE, 2))
            For LE = 1 To UBound(TabE, 1)
                If Application.CountIf(Plage, TabE(LE, col).Value) > 1 Then  '---> erreur ICI
                    LS = LS + 1
                        For c = 1 To UBound(TabE, 2)
                        TabS(LS, c) = TabE(LE, c)
                        Next c
                End If
            Next LE
    Next i
  
   'Création d'un nouveau classeur et "collage" du tableau contenat les lignes dans ce classeur
   Workbooks.Add
   ActiveSheet.[A2].Resize(LS, UBound(TabS, 2)).Value = TabS
  

End Sub

NB : j'ai également déjà beaucoup utilisé mon vecteur "Noms_feuilles" et la procédure qui l'initialise, l'erreur ne vient surement pas de là.
Idéalement j'aurai aimé pouvoir détecter les doublons dans toutes les feuilles et pas seulement rassembler les doublons de chacune des feuilles mais je ne vois pas comment faire.

En vous remerciant par avance !

Louise

 

[pierrejean]

Bonjour louloubru
La recherche de doublons passe généralement par l'utilisation d'un dictionnaire
Peux-tu poster un exemple de ton fichier : Quelques feuilles ,quelques lignes et des données 'bidon' ??

 

[louloubru]

Bonjour,
merci cette réponse.
Qu'entendez-vous par un dictionnaire ?
Il s'agit de contacts dans plusieurs feuilles, avec des données de contact (donc nom prénom organisme num téléphone etc.). Cela ne sert pas à grand chose que je vide mon fichier où il n'y aurait plus ne noms...
Cette instruction fonction sur une feuille :

Cela colorie en rouge les doublons sur ma feuille. Maintenant au lieu de les colorier en rouge sur une feuille je voudrais les copier coller (pour toutes les feuilles) dans un autre classeur :

Sub doublon()
 
    Dim Plage As Range
    Dim Cel As Range
 
    With ActiveSheet
 
       Set Plage = .Range(.Cells(2, 7), .Cells(.Rows.Count, 7).End(xlUp))
 
    End With
 
   For Each Cel In Plage
 
        If Application.CountIf(Plage, Cel.Value) > 1 Then Cel.Interior.ColorIndex = 3
 
    Next Cel
 
End Sub

 

[pierrejean]

RE

Vois si tu peux t'inspirer de ceci

 

[louloubru]

RE

Vois si tu peux t'inspirer de ceci

Bonjour,
désolée pour cette réponse tardive, merci beaucoup !!!! J'ai pu l'adapter très facilement, concaténer nom-prénom, afficher dans un autre classeur ... Impeccable ! En plus c'est un bon exemple d'utilisation de dictionnaire ont je pourrai me resservir.

Avec vraiment tous mes remerciements,

Louise

 

[louloubru]

Re-bonjour,

j'ai maintenant un autre soucis du même genre : grâce à votre code j'ai pu afficher dans un autre classeur les doublons présents dans mon classeur de base. Je voudrais maintenant comparer cette liste de doublons avec une autre liste présente dans la feuille "Doublons_validés" de mon classeur et que les doublons affichés dans le nouveau classeur se colorient s'ils sont présent dans cette liste.
J'ai ajouté le code suivant au code de base qui affiche les doublons dans le nouveau classeur et il ne se passe absolument rien ...

'Afficher les doublons validés
 
Dim plage As Range
Dim Cel As Range
 
With ActiveSheet
 
       Set plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
End With
 
   For Each Cel In plage
 
        If Application.WorksheetFunction.CountIf(Workbooks(base).Sheets("Doublons_validés").Range("A:A"), Cel.Value) > 1 Then Cel.Interior.ColorIndex = 3
 
    Next Cel

Pourtant j'ai copié exactement certain doublons dans la première colonne de la feuille "Doublons_validés" de mon classeur de base ...
Je n'ai pas d'erreur, mais pas de case coloriées en rouge non plus ...

Comprenez-vous pourquoi ou avez-vous une autre solution ?

En vous remerciant par avance,

Louise

 

[pierrejean]

Re

Je ne souhaite pas passer du temps a construire des fichiers d'essai !!!
Peux-tu faire des copies de tes fichiers en ne laissant que le nécessaire à la compréhension du problème et en remplaçant les données par des données 'bidon' (quelques données suffisent)

 

[louloubru]

Re

Je ne souhaite pas passer du temps a construire des fichiers d'essai !!!
Peux-tu faire des copies de tes fichiers en ne laissant que le nécessaire à la compréhension du problème et en remplaçant les données par des données 'bidon' (quelques données suffisent)

Bonjour,

ci-joint le fichier que vous m'aviez envoyé, un peu modifié et avce la partie du code ci-dessus qui ne fonctionne pas (pas d'erreur mais le coloriage en rouge attendu n'apparaît pas).

En vous remerciant par avance,

Louise

 

[pierrejean]

Re

Vois si cela convient

 

[louloubru]

Bonjour,
impeccable, merci beaucoup, j'aurai dû y penser plus tôt et arrêter de m'acharner avec cette fonction CountIf.

Merci pour tout,

Louise