'---------------------------------------------------------------------------------------
' Module    : Module1
' Author    : Íèêîëàé (nilem), lng0967@mail.ru
' Date      : 12.12.2010
' Purpose   : http://www.programmersforum.ru/showthread.php?t=126381
'---------------------------------------------------------------------------------------

Option Explicit
Dim arr2() As Variant  ' объявили массив для записи в него данных из закрытых файлов Эксель из диапазона AS9:EK17

Sub GetValue2()
Dim f As String, i As Long, j As Byte
Dim x(1 To 9, 1 To 97)  ' объявили массив куда будем записывать суммы ячеек из всех закрытых файлов из диаппазонов AS9:EK17
Application.ScreenUpdating = False

f = Dir(ThisWorkbook.Path & "\" & "*.xls*", vbNormal)  '  сюда пишем путь к файлам эксель

' циклом перебираем все закрытые файлы эксель в папке, кроме текущего открытого файла, то есть кроме файла Свод.хls
Do While f <> ""   
    If f <> ThisWorkbook.Name Then
10        [a1].Formula = "=ToArr2('" & ThisWorkbook.Path & "\[" & f & "]P-2.1'!AS9:EK17)"  ' сюда помещаем все данные из закрытой книги эксель из диппазона AS9:EK17

' циклом заполняем массив x(i,j) суммами или текстом из ячеек AS9:EK17 закрытых файлов , то есть из массива arr2

        For i = 1 To 9
            For j = 1 To 97 Step 16
                If IsNumeric(arr2(i, j)) Then
                    x(i, j) = x(i, j) + arr2(i, j)
         
                Else
                    x(i, j) = arr2(i, j)
                End If
            Next j
        Next i
    End If: f = Dir()  '  переходим к следующему файлу в папке

Loop

Range("AS9:EK17").Value = x  ' заполняем данными массива x  диппазон AS9:EK17 в файле Свод.xls
[a1].Value = "" ' обнуляем значение ячейки a1 в активном листе.
Application.ScreenUpdating = True
End Sub

' ZVI:2010-09-16 http://www.planetaexcel.ru/forum.php?thread_id=19264
Private Function ToArr2(ref)   '   функция помещающая в массив arr2  значения из диаппазона AS9:EK17 закрытой книги Эксель , находящейся по адресу: ThisWorkbook.Path & "\[" & f & "]P-2.1
    arr2 = ref
    
End Function

Sub ert()
If ActiveSheet.Name = "Ð-2.1" Then MsgBox "ok"
End Sub