Sub GetUnique()
Dim arr1(), arr2(), arrUniq()
Dim dic As Object
Dim iKey, I&
On Error Resume Next
arr1 = Worksheets("Sheet1").ListObjects("Таблица1").DataBodyRange.Value
arr2 = Worksheets("Sheet2").ListObjects("Таблица1345").DataBodyRange.Value
ReDim arrUniq(1 To UBound(arr1, 1) + UBound(arr2, 1), 1 To 6)
Set dic = CreateObject("Scripting.Dictionary")
For I = LBound(arr1, 1) To UBound(arr1, 1)
  iKey = arr1(I, 2) & "|" & arr1(I, 3)
  If Not dic.Exists(iKey) Then dic.Add iKey, arr1(I, 4) & "|" & arr1(I, 5) & "|" & arr1(I, 6)
Next
For I = LBound(arr2, 1) To UBound(arr2, 1)
  iKey = arr2(I, 2) & "|" & arr2(I, 3)
  If Not dic.Exists(iKey) Then dic.Add iKey, arr2(I, 4) & "|" & arr2(I, 5) & "|" & arr2(I, 6)
Next
I = 0
For Each iKey In dic.Keys
  I = I + 1
  arrUniq(I, 1) = I
  arrUniq(I, 2) = Split(iKey, "|")(0)
  arrUniq(I, 3) = Split(iKey, "|")(1)
  If Split(dic(iKey), "|")(0) = "" Then arrUniq(I, 4) = Empty Else arrUniq(I, 4) = CLng(Split(dic(iKey), "|")(0))
  If Split(dic(iKey), "|")(1) = "" Then arrUniq(I, 5) = Empty Else arrUniq(I, 5) = CDbl(Split(dic(iKey), "|")(1))
  If Split(dic(iKey), "|")(2) = "" Then arrUniq(I, 6) = Empty Else arrUniq(I, 6) = CDbl(Split(dic(iKey), "|")(2))
Next
With Worksheets("Sheet3").ListObjects("Таблица134")
  If .ListRows.Count = 0 Then .ListRows.Add AlwaysInsert:=True
  .DataBodyRange(1, 1).Resize(I, 6) = arrUniq
End With
End Sub