Сравнения двух книг и запись уникальных на новую

Sub tt()
    Dim a, b, i&, t$, tt$, k
    With CreateObject("scripting.dictionary"): .comparemode = 1
        a = Workbooks("Книга1").Sheets(1).[K1].CurrentRegion.Value
        For i = 2 To UBound(a)
            .Item(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)) = i
        Next
        b = Workbooks("Книга2").Sheets(1).[K1].CurrentRegion.Value
        For i = 2 To UBound(b)
            Do
                tt = b(i, 1) & "|" & b(i, 2) & "|"
                t = tt & b(i, 3)
                If .exists(t) Then .Remove (t): Exit Do
                t = tt & (b(i, 3) - 1)
                If .exists(t) Then .Remove (t): Exit Do
                t = tt & (b(i, 3) + 1)
                If .exists(t) Then .Remove (t)
                Exit Do
            Loop
        Next
 
        ReDim b(1 To .Count + 1, 1 To 3): i = 1
        b(1, 1) = "A num": b(1, 2) = "B num": b(1, 3) = "sec"
        For Each k In .items
            i = i + 1
            b(i, 1) = a(k, 1): b(i, 2) = a(k, 2): b(i, 3) = a(k, 3)
        Next
    End With
 
    With Workbooks.Add(1).Sheets(1).[a1].Resize(i, 3)
        .Columns(1).Resize(, 2).NumberFormat = "0"
        .Value = b
        .Columns.AutoFit
    End With
End Sub

Option Explicit
 
Sub tt()
    Dim a, b, i&, t$, tt$, k
    With CreateObject("scripting.dictionary"): .comparemode = 1
 
        a = Workbooks("Книга1").Sheets(1).[a1].CurrentRegion.Columns(1).Resize(, 3).Value    'тут можно скорректировать с какого столбца начинать массив
        For i = 2 To UBound(a)    'собираем словарь
            .Item(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)) = i
        Next
 
        b = Workbooks("Книга2").Sheets(1).[E1].CurrentRegion.Columns(1).Resize(, 3).Value    'тут можно скорректировать с какого столбца начинать массив
        For i = 2 To UBound(b)    'выкидываем из словаря повторы точные или с коррекцией +/-1
            tt = b(i, 1) & "|" & b(i, 2) & "|"
            Select Case True
                Case .exists(tt & b(i, 3)): .Remove (tt & b(i, 3))
                Case .exists(tt & (b(i, 3) - 1)): .Remove (tt & b(i, 3) - 1)
                Case .exists(tt & (b(i, 3) + 1)): .Remove (tt & b(i, 3) + 1)
            End Select
        Next
 
        ReDim b(1 To .Count + 1, 1 To 3): i = 1
        b(1, 1) = "A num": b(1, 2) = "B num": b(1, 3) = "sec"
        For Each k In .items    'перебор оставшихся в словаре номеров строк
            i = i + 1
            b(i, 1) = a(k, 1): b(i, 2) = a(k, 2): b(i, 3) = a(k, 3)
        Next
    End With
 
    With Workbooks.Add(1).Sheets(1).[a1].Resize(i, 3)
        .Columns(1).Resize(, 2).NumberFormat = "0"
        .Value = b
        .Columns.AutoFit
    End With
End Sub