Sub tt()
Dim sh As Object, i&, ii&, t$, tt$
Dim d As Object

Set d = CreateObject("Scripting.Dictionary")

'собираем в словаре общее количество всего, без дат (но можно добавить и даты, если нужны суммы на дату)
For Each sh In Worksheets
    With sh.Cells(1).CurrentRegion
        For i = 3 To .Rows.Count
            t = .Cells(i, 1) & "|"
            For ii = 2 To .Columns.Count
                If .Cells(i, ii) > 0 Then
                    tt = t & .Cells(2, ii)
                    d.Item(tt) = d.Item(tt) + .Cells(i, ii)
                End If
            Next
        Next
    End With
Next

'выгрузка собранного, можно в шаблон в другой книге аналогично тому как собирали, а можно просто в прямую таблицу
Dim kk
    With Workbooks.Add.Sheets(1)
        i = 0
        For Each kk In d.keys
        i = i + 1
        .Cells(i, 1).Resize(, 3) = Array(Split(kk, "|")(0), Split(kk, "|")(1), d(kk))
        Next
        .Cells.EntireColumn.AutoFit
    End With

End Sub

Sub tt()
Dim rezult As Range, i&, shag&

shag = 10

For i = 1 To [a1].CurrentRegion.Rows.Count Step shag
    Set rezult = Cells(i, 1).Resize(shag, 4)
    rezult.Select ' вот тут вместо выделения делайте что угодно с этим диапазоном - копировать в другое место, в новый лист, в новый файл, в текст...
Next

End Sub

Option Explicit

Sub Должности()
    Dim tbSource As ListObject
    Set tbSource = ActiveSheet.ListObjects("Таблица1")
 
    Dim tbTarget As ListObject
    Set tbTarget = ActiveSheet.ListObjects("Таблица24")
 
    Dim i&, ii&, t$
    Dim a As Variant, b As Variant, el
    Dim col As Collection, d As Object
    Set d = CreateObject("Scripting.Dictionary")
    
    a = tbSource.DataBodyRange.Value
    
    'заполняем словарь
    For i = 1 To UBound(a)
        For ii = a(i, 2) To a(i, 3)
            d(a(i, 1) & "|" & ii) = a(i, 4)
        Next
    Next
    
    a = tbTarget.DataBodyRange.Value
    b = tbTarget.ListColumns("должность").DataBodyRange.Value
    
    'извлекаем из словаря в коллекцию уникальные, из неё в массив
    On Error Resume Next
    For i = 1 To UBound(a)
    Set col = Nothing: Set col = New Collection
        For ii = a(i, 2) To a(i, 3)
            t = a(i, 1) & "|" & ii
         If d.exists(t) Then col.Add d(t), CStr(d(t))
        Next
        If col.Count Then
        t = ""
        For Each el In col: t = t & ", " & el: Next
        b(i, 1) = Mid(t, 3)
        End If
    Next
    On Error GoTo 0
    
    'выгрузка результата
    tbTarget.ListColumns("должность").DataBodyRange.Value = b
    
End Sub