Sub Результат_doober()
    Dim avFiles, Sh As Worksheet, key, ShIn As Worksheet
    Set C_rab = CreateObject("scripting.dictionary")
    Set C_is = CreateObject("scripting.dictionary")
    Set Sh = ThisWorkbook.Worksheets("Свод")
    LastRow = Sh.Cells(Sh.Rows.count, "C").End(xlUp).Row
    LastColl = Sh.Cells(2, Sh.Columns.count).End(xlToLeft).column
    hd = Sh.Cells(2, 1).Resize(1, LastColl)
    dx = Sh.Cells(1, 3).Resize(LastRow, 2)
    For n = 3 To UBound(hd, 2)
        key = hd(1, n)
        If IsDate(key) Then
            C_is.Item(CDate(key)) = n
        End If
    Next
    For n = 3 To UBound(dx)
        key = dx(n, 1) & ""
        C_rab.Item(key) = n
    Next
    'по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb)
    avFiles = Application.GetOpenFilename _
            ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
    If VarType(avFiles) = vbBoolean Then
        'была нажата кнопка отмены - выход из процедуры
        Exit Sub
    End If
    'avFiles - примет тип String
    Dim i, j
    Application.ScreenUpdating = False
    For Each x In avFiles
        Set ShIn = Workbooks.Open(x).Worksheets(1)
        key = CDate(ShIn.Range("d3"))
        If C_is.Exists(key) Then
            LastRow = ShIn.Cells(Sh.Rows.count, "C").End(xlUp).Row
            dz = ShIn.Range("C1").Resize(LastRow, 2)
            cl = C_is.Item(CDate(key))
            For i = 6 To UBound(dz)
                key = dz(i, 1) & ""
                Sum = dz(i, 2)
                If C_rab.Exists(key) Then
                    rw = C_rab.Item(key)
                    Sh.Cells(rw, cl) = Sh.Cells(rw, cl) + Sum
                End If
            Next
        End If
        ShIn.Parent.Close (False)

    Next
    Application.ScreenUpdating = True
End Sub