Comparer valeurs 2 colonnes et copier sans doublons

Bonjour,

Je suis bloqué sur un probléme simple ( fichier en PJ)

J'aimerai faire une boucle qui permet de comparer les valeurs des colonnes A de la feuil 1 et de la feuil2 et de coller les valeurs sans doublons dans la colonne A de la feuille : Résultat

Chose qui doit être peu compliqué, mais je n'y arrive ...

Je vous remercie par avance de votre contribution,

Merci encore.


36classeur1.xlsm (16.50 Ko)
Sub Bouton1_Cliquer()

Dim Titres As Object
Set Titres = CreateObject("Scripting.Dictionary")

Sheets("Feuil1").Select
For i = 1 To Cells(Application.Rows.Count, 1).End(xlUp).Row
    Titres((Cells(i, 1))) = Cells(i, 1)
Next

Sheets("Feuil2").Select
For i = 1 To Cells(Application.Rows.Count, 1).End(xlUp).Row
    Titres((Cells(i, 1))) = Cells(i, 1)
Next

Sheets("Resultat").Select
Range("A1").Resize(Titres.Count) = Application.Transpose(Titres.Items)

End Sub

Bonjour,

Une proposition avec la méthode 'Supprimer les doublons'

Cdlt.

39classeur1.xlsm (20.92 Ko)
Public Sub Bouton1_Cliquer()
Dim ws As Worksheet, lRow As Long, bln As Boolean
    ' Gel affichage
    Application.ScreenUpdating = False
    ' Supression valeurs existantes
    ActiveSheet.Cells(1).CurrentRegion.ClearContents
    bln = False

    For Each ws In ActiveWorkbook.Worksheets(Array("Feuil1", "Feuil2"))
        If bln = False Then
            ' Copie avec en-têtes de colonnes (Feuil1)
            ws.Cells(1).CurrentRegion.Columns(1).Copy Destination:=ActiveSheet.Cells(1)
            bln = True
        Else
            ' Calcul ligne pour recopie (derniere ligne non vide +1)
            lRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
            ' Copie sans en-têtes de colonnes (Feuil2)
            ws.Cells(1).CurrentRegion.Columns(1).Offset(1, 0).Copy Destination:=ActiveSheet.Cells(lRow, 1)
        End If
    Next ws

    With ActiveSheet.Cells(1)
        ' Tri
        .Sort key1:=.Cells(2, 1), order1:=xlAscending, Header:=xlYes
        ' Suppression doublons
        .CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
    End With

End Sub

Super merci à vous deux !

La semaine va bien commencer

Rechercher des sujets similaires à "comparer valeurs colonnes copier doublons"