FreeRow1 = 2
    RowStart = 2
    n = 3
    With Sheets("ЕС")
        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        For i = n To LastRow
            If .Cells(i, 1) <> "" Then
                DR = .Cells(i, 1)
                Cells(FreeRow1, 1) = .Cells(i, 1)
            End If
            For ii = i To LastRow
                If .Cells(ii, 1) = DR Or .Cells(ii, 1) = "" Then
                    If .Cells(ii, 3) > 0 Then
                        Set Rng = Sheets("справочник").Range("B2:C999").Find(what:=.Cells(ii, 2), LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Rng Is Nothing Then
                            If Rng.Column = 2 Then
                                Cells(FreeRowStroy, 2) = .Cells(ii, 2)
                                Cells(FreeRowStroy, 4) = .Cells(ii, 3)
                                CounterStroy = CounterStroy + 1
                                FreeRowStroy = FreeRowStroy + 1
                            Else
                                Cells(FreeRowMont, 5) = .Cells(ii, 2)
                                Cells(FreeRowMont, 7) = .Cells(ii, 3)
                                CounterMont = CounterMont + 1
                                FreeRowMont = FreeRowMont + 1
                            End If
                        End If
                    End If
                Else
                    i = ii - 1
                    If FreeRowStroy > FreeRowMont Then
                        FreeRow1 = FreeRowStroy
                    Else
                        FreeRow1 = FreeRowMont
                    End If
                    Cells(FreeRow1, 2) = "Итого:" & DR
                    Cells(FreeRow1, 3) = CounterStroy
                    Cells(FreeRow1, 5) = "Итого:" & DR
                    Cells(FreeRow1, 6) = CounterMont
                    Cells(FreeRow1, 7) = "summa"         <<<-------------------     подскажите как суммировать нужный диапазон
                    CounterStroy = 0
                    CounterMont = 0
                    With Range(Cells(RowStart, 1), Cells(FreeRow1, 1))
                        .Merge
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .BorderAround Weight:=xlThin
                    End With
                    Range(Cells(FreeRow1, 2), Cells(FreeRow1, 7)).Interior.ColorIndex = 15
                    Range(Cells(RowStart, 2), Cells(FreeRow1, 7)).Borders.LineStyle = True
                    RowStart = FreeRow1 + 1
                    FreeRow1 = FreeRow1 + 1
                    FreeRowStroy = FreeRow1
                    FreeRowMont = FreeRow1
                    Exit For
                End If
            Next
            If ii > LastRow Then
                Cells(FreeRow1 + 1, 2) = "Итого:"
                Cells(FreeRow1 + 1, 3) = CounterStroy
                Cells(FreeRow1 + 1, 5) = "Итого:"
                Cells(FreeRow1 + 1, 6) = CounterMont
                With Range(Cells(RowStart, 1), Cells(FreeRow1 + 1, 1))
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .BorderAround Weight:=xlThin
                End With
                Range(Cells(FreeRow1 + 1, 2), Cells(FreeRow1 + 1, 7)).Interior.ColorIndex = 15
                Range(Cells(RowStart, 2), Cells(FreeRow1 + 1, 7)).Borders.LineStyle = True
                Exit Sub
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub