Sub Результат_по_осям()
Dim avFiles
'по умолчанию к выбору доступны файлы 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 tab_worker As String
Dim i, j, count, column As Integer
Dim result As Double
Dim flag As Boolean
count = 4
For Each x In avFiles
Workbooks.Open x
i = 6
Dim Name As String
Name = ActiveWorkbook.Name
Do While ActiveWorkbook.Sheets("Свод").Cells(i, 2).Value <> ""
Workbooks(Name).Activate
For k = 4 To 1000

If ActiveWorkbook.Sheets("Свод").Cells(4, k).Value = "Сумма" Then

column = k
k = 1001

End If

Next

result = CDbl(ActiveWorkbook.Sheets("Свод").Cells(i, column).Text)
tab_worker = ActiveWorkbook.Sheets("Свод").Cells(i, 3).Value
Workbooks("Свод по сварки осей.xlsm").Activate
flag = True
j = 3
Do While flag = True

If tab_worker = ActiveWorkbook.Sheets("Свод").Cells(j, 3).Value Then

flag = False
ActiveWorkbook.Sheets("Свод").Cells(j, count).Value = CStr(result)

End If
j = j + 1

Loop
i = i + 1

Loop

Next

End Sub

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

set wb=Workbooks.Open(x)
    for each ShIn in wb.Worksheets
'  много кода
    next
wb.close(false)