Affichage des doublons par lignes entières de 2 classeurs

Bonjour,

Je suis débutant Excel et n'ai pas trouvé la réponse à mon problème dans le forum.

2 fichiers EXCEL 2007 sont joints mais la solution à trouver est pour EXCEL 2003.

Le problème est que je souhaiterais comparer 2 classeurs, ligne par ligne, d'une feuille de chacun d'eux, et lorsque un doublon sur un numéro de contrat (colonne CONTRAT 1 ou CONTRAT 2 ou le NOM) est repéré, l'afficher mais avec toute la ligne...

Je sais pas si c'est vraiment clair, mais vous trouverez en pièces-jointes 2 classeurs...sur les classeurs PC et PI il y a des doublons sur le n° contrat (1 ou 2) et/ou sur le nom...il faudrait pouvoir les afficher sur une autre feuille d'un des 2 classeurs par exemple, mais avec la ligne entière.

J'espère qu'avec les classeurs ce sera plus clair.

Merci d'avance de votre aide.

Bonne journée

Cdt,

Bonjour,

Une solution à tester.

1/ On crée une feuille regroupant les 2 classeurs à laquelle on ajoute une colonne "Classeur"

2/ On crée un TCD avec les critères demandés pour mettre en évidence les doublons.

3/ La somme > 1 signifie doublons

4/ un double click sur le total de la ligne > 1 affiche une feuille regroupant les infos demandées.

Voir fichier joint.

Cdlt

Bonjour,

Merci de la réponse, c'est sympa !

Par contre je me demande si cela est possible avec EXCEL 2003 !

De plus, il me faudra créer une feuille regroupant les deux tableaux, mais il faut savoir que dans chaque classeur il y a quand même minimum 500 lignes...ça ira quand même ?

Merci d'avance.

Cdt,

Re,

Pas de problème de compatibilité 2003-2010 pour ce type de procédure.

Cdlt

Re,

Pour une consolidation de 2 feuilles dans une 3ème, voir cet exemple.

*fichier joint - Ctrl+a pour lancer la procédure

Cdlt.

Bonjour,

autre proposition :

• copier les lignes des 2 feuilles sur une feuille (ajouter la colonne Classeur d'origine)
• ajouter une colonne Doublons avec :

• trier la colonne doublon en croissant pour rassembler les doublons
• éventuellement supprimer les lignes 'ok' rassemblées en bas

eric

Merci à vous deux pour votre aide

Y-a-t-il un moyen d'identifier les doublons et les afficher sur une feuille sans avoir à copier toutes les lignes des 2 tableaux ?

Encore merci de votre aide

Cdt,

En fait, j'avais oublié de vous dire que dans un des tableaux il a déjà des doublons, comment dans faire dans ce cas ?

Il y aurait des triplons ?

Merci !

Re,

En fait, j'avais oublié de vous dire que dans un des tableaux il a déjà des doublons, comment dans faire dans ce cas ?

Il faudra qu'ils soient dans le classeur PI.xls, sinon tu adaptes la macro.

Sub doublons()
    Dim sh1 As Worksheet, sh2 As Worksheet, shDest As Worksheet
    Dim lig As Long, col As Long, ligDest As Long, c As Range, adr1 As String
    Dim ligOK() As Boolean

    '
    Application.ScreenUpdating = False
    Set sh1 = Workbooks("PC.xls").Worksheets("Feuil1")
    Set sh2 = Workbooks("PI.xls").Worksheets("Feuil1")
    ' créer feuille Doublons vierge
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Doublons").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Set shDest = Sheets.Add
    shDest.Name = "Doublons"
    '
    ligDest = 2
    For lig = 3 To sh1.Cells(Rows.Count, 1).End(xlUp).Row
        ReDim ligOK(sh2.Cells(Rows.Count, 1).End(xlUp).Row)
        For col = 1 To 3
            With sh2.Columns(col)
                Set c = .Find(sh1.Cells(lig, col), LookIn:=xlValues, lookat:=xlWhole)
                If Not c Is Nothing Then
                    adr1 = c.Address
                    Do
                        If Not ligOK(c.Row) Then
                            If adr1 = c.Address Then
                                sh1.Cells(lig, 1).Resize(1, 6).Copy shDest.Cells(ligDest, 1).Resize(1, 6)
                                shDest.Cells(ligDest, 7) = sh1.Parent.Name
                                shDest.Cells(ligDest, 1).Resize(1, 7).Interior.ColorIndex = 20
                                ligDest = ligDest + 1
                            End If
                            sh2.Cells(c.Row, 1).Resize(1, 6).Copy shDest.Cells(ligDest, 1).Resize(1, 6)
                            shDest.Cells(ligDest, 7) = sh2.Parent.Name
                            ligDest = ligDest + 1
                            ligOK(c.Row) = True
                        End If
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> adr1
                End If
            End With
        Next col
    Next lig
    ' titres
    sh1.Cells(1, 1).Resize(1, 6).Copy shDest.Cells(1, 1).Resize(1, 6)
    shDest.Cells(1, 7) = "Classeur"
    Application.ScreenUpdating = True
End Sub

eric

Encore un grand merci eric, c'est super sympa, ça fonctionne parfaitement !

Très bonne soirée à toi !

Salutations