Option Explicit
Sub FilterFrom2List()
Dim Rng As Range, sRng As Range
Dim eRw As Long, jJ As Long, bSh As Byte
Dim Sh As Worksheet, Sh0 As Worksheet
Set Sh0 = Sheets("S0"): Sh0.UsedRange.Offset(1).Clear
Application.ScreenUpdating = False
For bSh = 1 To 2
Set Sh = Choose(bSh, Sheets("D1"), Sheets("D2"))
Set Rng = Sh.Range(Sh.[b1], Sh.[b1].End(xlDown))
Sheets(Choose(bSh, "D2", "D1")).Select
eRw = [b65500].End(xlUp).Row
For jJ = 2 To eRw
Set sRng = Rng.Find(Cells(jJ, "B").Value, , xlFormulas, xlWhole)
If sRng Is Nothing Then
Sh0.[b65500].End(xlUp).Offset(1) = Cells(jJ, "B").Value
Cells(jJ, "B").Interior.ColorIndex = 35 + 2 * bSh
End If
Next jJ
Next bSh
End Sub