'Считать по группам в одном столбце. Работает в выделенном диапазоне. Результат на создаваемом листе «REP». Присутствуют проверки
'Автор: Владимир
'Упражнялся с чужим кодом: Jack Famous
'Тема на форуме: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=97031&TITLE_SEO=97031-znacheniya-pod-kategoriyami-v-odnom-stolbtse
'=======================================================================================================================================================
Option Explicit
Sub MathInOneColumn()
Dim ash As Worksheet, rep As Worksheet
Dim rng As Range, rngBlanks As Range, rngnum As Range, zone As Range
Dim i&

Set rng = Selection

    If rng.Columns.Count <> 1 Then
        MsgBox "Не более 1 столбца!", vbExclamation, "Ошибка выделения"
        Exit Sub
    End If
    
On Error Resume Next
Set rngBlanks = rng.SpecialCells(xlCellTypeBlanks)
    If Not rngBlanks Is Nothing Then
        MsgBox "Присутствуют пустые!", vbExclamation, "Ошибка выделения"
        Exit Sub
    End If
On Error GoTo 0

    If IsNumeric(rng.Cells(1)) Then
        MsgBox "Должно начинаться с текста!", vbExclamation, "Ошибка выделения"
        Exit Sub
    End If
    
Set ash = ActiveSheet
    
On Error Resume Next
    If Worksheets("ОТЧЁТ") Is Nothing Then Worksheets.Add.name = "ОТЧЁТ"
On Error GoTo 0
Worksheets("ОТЧЁТ").Delete
Worksheets.Add.name = "ОТЧЁТ"
    
Set rep = Worksheets("ОТЧЁТ")
rep.Tab.color = vbRed

ash.Activate
Set rngnum = rng.SpecialCells(xlCellTypeConstants, xlNumbers)

Application.ScreenUpdating = 0
i = 0
    For Each zone In rngnum.Areas
        i = i + 1
        rep.Range("A" & i) = Cells(zone.Row - 1, 1)
        rep.Range("B" & i) = Application.WorksheetFunction.Sum(Cells(zone.Row, 1).Resize(zone.Rows.Count))
    Next zone
Application.ScreenUpdating = 1
rep.Select
End Sub