Sub dsd()
Dim col As New Collection, lr As Long, i As Long, sh As Worksheet, d As Worksheet
Set d = Worksheets("дата")
lr = d.Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю заполненную ячейку в столбце 1 листа "дата"
For i = 2 To lr 'цикл со 2 строчки до последней заполненной листа "дата"
    On Error Resume Next
    col.Add d.Cells(i, 1).Value, CStr(d.Cells(i, 1).Value) 'создаем коллекцию уникальных фамилий с листа "дата"
Next i
For Each sh In Worksheets 'цикл по листам
    If sh.Name <> d.Name Then 'проверяем чтобы имя листа не было равным "дата" и если это не так выходим и идем к следующему листу
        For i = 1 To col.Count ' цикл по коллекции
            sh.Cells(i + 1, 1) = col(i) 'вставляем итое значение коллекции на выбранный лист циклом
            sh.Cells(i + 1, 2) = Application.WorksheetFunction.SumIfs(d.Columns(3), d.Columns(1), col(i), d.Columns(2), "*" & sh.Name & "*") 'суммируем по фио и по наличии имени листа 
        Next i
    End If
Next sh
End Sub