Sub SvodZp()
'Суммирование зарплаты по программам
Dim BookSource As Workbook
Dim wsListSource As Worksheet
Dim wsListTarget As Worksheet

Dim sListTarget As String 'имя вкладки сводного файла мишени
Dim sListSource As String 'имя вкладки файла источника
Dim sFileSourcePath As String
Dim sFileSourceName As String
Dim iCodeMedorg As Integer 'код медорганизации
Dim sNameMedorg As String
Dim iRowTarget, iRowSource As Integer
Dim iRowBudgetProg As Integer
Dim iSpecific, iSpecificS As Integer

Dim sBudgetProg As String
Dim sngBudgetProgItogo As Single
    
    sFileSourcePath = ThisWorkbook.Path
    sFileSourcePath = Left(sFileSourcePath, InStrRev(sFileSourcePath, "\"))
    sFileSourceName = Dir(sFileSourcePath & "*.xls")
        
    iRowBudgetProg = 3 'Бюджетные программы кроме сметы

    Set wsListTarget = ThisWorkbook.Worksheets(Лист1)
    wsListTarget.Activate

Sub OprosFiles()
'Опрос файлов в папке
    
    Dim BookSource As Workbook
    Dim ListSource As Worksheet
    Dim ListTarget As Worksheet
    Dim iRowSource As Integer
    Dim iRowTarget As Integer
    Dim sFileSourcePath As String
    Dim sFileSourceName As String
    Dim sFileNameBrief As String 'переменная для имени файла
    
    Set ListTarget = ActiveSheet
    'Set ListTarget = ThisWorkbook.ActiveSheet
    
    If ThisWorkbook.ActiveSheet.Cells(2, 1) <> "" Then
        Call MsgBox("Перечень файлов уже создан!", vbCritical)
        Exit Sub
    Else
        iRowTarget = 2
        sFileSourcePath = ThisWorkbook.Path
        sFileSourcePath = Left(sFileSourcePath, InStrRev(sFileSourcePath, "\"))
        sFileSourceName = Dir(sFileSourcePath & "*.xls")
        
        Do While sFileSourceName <> ""
            Set BookSource = Workbooks.Open(sFileSourcePath & sFileSourceName)
            Set ListSource = BookSource.Worksheets("имя")
            
            
            ListTarget.Activate
                'Записываем код медорганизации
                ListTarget.Cells(iRowTarget, 1) = ListSource.Cells(iRowSource, 5)

                'Записываем краткое название медорганизации
                ListTarget.Cells(iRowTarget, 2) = ListSource.Cells(iRowSource, 4)

                'Записываем имя файла медорганизации
                ListTarget.Cells(iRowTarget, 3) = sFileNameBrief
                iRowTarget = iRowTarget + 1
            
            BookSource.Close (False)
            sFileSourceName = Dir
        Loop
    End If
End Sub