Comparaison BD : Ajout-Suppression

[stefkeno]

Bonjour à tous,

J'ai de nouveau un problème pour mes bases de données. Je vous explique mon problème :

J'ai 2 bases de données (BD1 et BD2). Le nombre d'entrées entre la BD1 et la BD2 est différent. Je souhaiterai faire une comparaison entre la BD1 et la BD2 (à partir de la BD1 sur la BD2) de manière a ce qu'il y est le même nombre d'entrées sur les 2 bases de données (Ajout de la BD1 vers la BD2 et Suppression de la BD2 par rapport à la BD1).

Je vous joins un fichier d'exemple.

Je vous remercie pour votre aide.

 

[jp14]

Re : Comparaison BD : Ajout-Suppression

Bonjour

Ci dessous une procédure pour copier ou supprimer ses données.

Private Sub CommandButton1_Click()
Dim Cellule As Range
Dim Nomfeuille1 As String
Dim plg2 As Range
Dim Col As String
Dim nb As Byte
Dim dl1 As Long
Dim i As Long
'parametre

Col = "A"
With Sheets("BD2")
    Set plg2 = .Range("a1:a" & .Range("A" & Rows.Count).End(xlUp).Row)
    For Each Cellule In Sheets(ActiveSheet.Name).Range(Col & "2:" & Col & Sheets(ActiveSheet.Name).Range(Col & Sheets(ActiveSheet.Name).Rows.Count).End(xlUp).Row)
    
    If WorksheetFunction.CountIf(plg2, Cellule) = 0 Then
        dl1 = .Range("A" & Rows.Count).End(xlUp).Row + 1
        Sheets(ActiveSheet.Name).Rows(Cellule.Row).Copy Destination:=.Range("a" & dl1)
    End If
Next Cellule

End With
With Sheets(ActiveSheet.Name)
    Set plg2 = .Range("a1:a" & .Range("A" & Rows.Count).End(xlUp).Row)
    For i = Sheets("BD2").Range(Col & Sheets("BD2").Rows.Count).End(xlUp).Row To 2 Step -1
        If WorksheetFunction.CountIf(plg2, Sheets("BD2").Range("a" & i)) = 0 Then
        Sheets("BD2").Rows(i).Delete Shift:=xlUp
        End If
Next i

End With




End Sub

A tester

JP

 

[stefkeno]

Re : Comparaison BD : Ajout-Suppression

Bonjour jp14,

Merci pour ce code VBA qui fonctionne très bien. C'est exactement ce qu'il me fallait.
Merci pour la rapidité de votre réponse, comme toujours sur le forum.

Stéphane