Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d_ As Range, d1_ As Range, d2_ As Range
    n11_ = Range("A" & Rows.Count).End(3).Row - 1
    n12_ = Range("F" & Rows.Count).End(3).Row - 1
    If Not Intersect(Union(Range("A2").Resize(n11_, 2), Range("F2").Resize(n12_, 2)), Target) Is Nothing Then
        Set slov = CreateObject("Scripting.Dictionary")
        ar1 = Range("A2").Resize(n11_, 2).Value
        ar2 = Range("F2").Resize(n12_, 2).Value
        With slov
            For i = 1 To n11_
                .Item(ar1(i, 1)) = .Item(ar1(i, 1)) + ar1(i, 2)
            Next i
            For i = 1 To n12_
                .Item(ar2(i, 1)) = .Item(ar2(i, 1)) + ar2(i, 2)
            Next i
            Application.EnableEvents = 0
            n_ = .Count
            Application.ScreenUpdating = 0
            Application.Calculation = xlCalculationManual
            Range("J3").Resize(n_) = Application.Transpose(.Keys)
            Range("K3").Resize(n_) = Application.Transpose(.Items)
            Application.EnableEvents = 1
        End With
        With Me.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("J2")
            .SetRange Range("J3:K" & n_ + 3)
            .Apply
        End With
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = 1
    End If
End Sub