Sub ExtractionValeurUnique()
Dim ShtS1 As Worksheet ' Feuille source 1
Dim ShtS2 As Worksheet ' Feuille source 2
Dim ShtD As Worksheet ' Feuille de Destination
Dim DLigS1 As Long, DLigS2 As Long, NLigD As Long, Lig As Long
Dim sForm As String
'
' Initialisation des variables
Set ShtS1 = Sheets("Feuil1") ' Définir la variable objet pour la feuille source 1
Set ShtS2 = Sheets("Feuil2") ' Définir la variable objet pour la feuille source 2
Set ShtD = Sheets("Feuil3") ' Définir la variable objet pour la feuille destination
'
' Récupérer le numéro de la dernière ligne des tableaux feuille 1 et 2
DLigS1 = ShtS1.Range("A" & Rows.Count).End(xlUp).Row
DLigS2 = ShtS2.Range("A" & Rows.Count).End(xlUp).Row
'
' Comparer les données de la Feuille 2 par rapport à la feuille 1
' Avec la feuille source 2
With ShtS2
' Pour chaque ligne en commençant par la fin
For Lig = DLigS2 To 2 Step -1
' Formule matricielle
' =SOMMEPROD((Feuil1!A2:A28=7320)*(Feuil1!B2:B28="Nunu"))
'
' Créer la formule matricielle pour vérifier que la ligne existe ou non
sForm = "SUMPRODUCT((" & ShtS1.Name & "!A2:A" & DLigS1 & "=" & .Range("A" & Lig) & ")*(" _
& ShtS1.Name & "!B2:B" & DLigS1 & "=""" & .Range("B" & Lig) & """))"
' Si la formule évaluée retourne 0 = pas de ligne existante en feuille 1
If Application.Evaluate(sForm) = 0 Then
' Prochaine ligne vide de la feuille de destination
NLigD = ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
' Couper la ligne pour la coller dans la feuilel de destination
.Rows(Lig).Cut Destination:=ShtD.Rows(NLigD)
' Supprimer la ligne vide
.Rows(Lig).Delete Shift:=xlUp
End If
Next Lig
End With
' Comparer les données de la Feuille 1 par rapport à la feuille 2
' Avec la feuille source 1
With ShtS1
' Pour chaque ligne en commençant par la fin
For Lig = DLigS1 To 2 Step -1
' Formule matricielle
' =SOMMEPROD((Feuil1!A2:A28=7320)*(Feuil1!B2:B28="Nunu"))
'
' Créer la formule matricielle pour vérifier que la ligne existe ou non
sForm = "SUMPRODUCT((" & ShtS2.Name & "!A2:A" & DLigS2 & "=" & .Range("A" & Lig) & ")*(" _
& ShtS2.Name & "!B2:B" & DLigS2 & "=""" & .Range("B" & Lig) & """))"
' Si la formule évaluée retourne 0 = pas de ligne existante en feuille 2
If Application.Evaluate(sForm) = 0 Then
' Prochaine ligne vide de la feuille de destination
NLigD = ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
' Couper la ligne pour la coller dans la feuilel de destination
.Rows(Lig).Cut Destination:=ShtD.Rows(NLigD)
' Supprimer la ligne vide
.Rows(Lig).Delete Shift:=xlUp
End If
Next Lig
End With
' Effacer les variables objet pour libérer la mémoire
Set ShtS1 = Nothing: Set ShtS2 = Nothing: Set ShtD = Nothing
End Sub