Salut le forum
Un code qui devrait répondre à ta demande
Option Explicit
Sub Extract()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wsNew As Worksheet, wsDiff As Worksheet
Dim CellInit As Range, CellFind As Range
Dim CellNew As Range, CellDiff As Range
Dim Cpt As Integer, Cpt2 As Integer
Set ws1 = [Feuil1]
Set ws2 = [Feuil2]
Set wsNew = [Feuil3]
Set wsDiff = [Feuil4]
Set CellNew = wsNew.Range("B2")
Set CellDiff = wsDiff.Range("B3")
For Each CellInit In ws2.Range("B2:B" & ws2.Cells(Rows.Count, 2).End(xlUp).Row)
Set CellFind = ws1.Range("B2:B" & ws1.Cells(Rows.Count, 2).End(xlUp).Row).Find(what:=CellInit, LookIn:=xlValues, lookat:=xlWhole)
If CellFind Is Nothing Then
For Cpt = -1 To 6
CellNew.Offset(0, Cpt) = CellInit.Offset(0, Cpt)
Next Cpt
Set CellNew = CellNew.Offset(1)
Else
For Cpt = 0 To 6
If CellFind.Offset(0, Cpt).Value <> CellInit.Offset(0, Cpt).Value Then
For Cpt2 = -1 To 6
CellDiff.Offset(0, Cpt2) = CellInit.Offset(0, Cpt2)
CellDiff.Offset(0, 8 + Cpt2) = CellFind.Offset(0, Cpt2)
Next Cpt2
Set CellDiff = CellDiff.Offset(1)
Exit For
End If
Next Cpt
End If
Next CellInit
Set ws1 = Nothing
Set ws2 = Nothing
Set wsNew = Nothing
Set wsDiff = Nothing
Set CellNew = Nothing
Set CellDiff = Nothing
End Sub
Mytå