Sub SumDuplicates()
Dim arr()
Dim I&, N&, J&, iKey
With Worksheets("Результат")
  arr = .Range("A3:D" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
ReDim arrSum(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(arr, 2))
With CreateObject("Scripting.Dictionary")
  For I = LBound(arr, 1) To UBound(arr, 1)
    iKey = arr(I, 1) & "|" & arr(I, 2)
    If .Exists(iKey) Then
      arrSum(N, 1) = arr(I, 1)
      arrSum(N, 2) = arr(I, 2)
      arrSum(N, 3) = arrSum(N, 3) + arr(I, 3)
      arrSum(N, 4) = arrSum(N, 4) + arr(I, 4)
    Else
      .Add iKey, Empty
      N = N + 1
      For J = 1 To 4: arrSum(N, J) = arr(I, J): Next
    End If
  Next
End With
Worksheets("Результат").Range("K3").Resize(N, 4) = arrSum
End Sub