Sub sync()
Dim a(), b(), c(), dr As Object, dc As Object, i&, ii&, ir&, ic&
'On Error Resume Next
Sheets("Вставить").UsedRange
a = Sheets("Вставить").UsedRange.Value
b = Sheets("Итог").UsedRange.Value
ReDim c(1 To UBound(b) + UBound(a), 1 To UBound(b, 2) + UBound(a, 2))
Set dr = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
For i = 2 To UBound(b)
If Not dr.exists(CStr(b(i, 1))) Then dr.Add CStr(b(i, 1)), i
Next
For ii = 2 To UBound(b, 2)
If Not dc.exists(CStr(b(1, ii))) Then dc.Add CStr(b(1, ii)), ii
Next

For i = 1 To UBound(b)
    For ii = 1 To UBound(b, 2)
        c(i, ii) = b(i, ii)
    Next
Next
ir = UBound(b): ic = UBound(b, 2)
For i = 2 To UBound(a)
    For ii = 2 To UBound(a, 2)
        If dr.exists(CStr(a(i, 1))) And dc.exists(CStr(a(1, ii))) Then
        c(dr(CStr(a(i, 1))), dc(CStr(a(1, ii)))) = a(i, ii)
        Else
        If Not dr.exists(CStr(a(i, 1))) Then ir = ir + 1: dr.Add CStr(a(i, 1)), ir: c(ir, 1) = a(i, 1)
        If Not dc.exists(CStr(a(1, ii))) Then ic = ic + 1: dc.Add CStr(a(1, ii)), ic: c(1, ic) = a(1, ii)
        c(dr(CStr(a(i, 1))), dc(CStr(a(1, ii)))) = a(i, ii)
        End If
    Next
Next
Sheets("Итог").Cells(1, 1).Resize(UBound(c), UBound(c, 2)) = c
End Sub