Sub Otbor()
     Dim a(), oDict As Object, i As Long, temp As String
      
     a = Range("a1:B" & Range("A" & Rows.Count).End(xlUp).Row).Value

     Set oDict = CreateObject("Scripting.Dictionary")
     For i = 1 To UBound(a)
         temp = UCase(Trim(a(i, 1)))
         If Not oDict.Exists(temp) Then
             oDict.Add temp, CStr(a(i, 2))
         Else
             oDict.Item(temp) = CStr(--oDict.Item(temp) + a(i, 2))
         End If
     Next

     With ThisWorkbook.Worksheets(1)
         .Range("D1").Resize(oDict.Count) = Application.Transpose(oDict.keys)
         .Range("E1").Resize(oDict.Count) = Application.Transpose(oDict.items)
     End With

End Sub