Макрос суммирования книг

[Extril]

Доброго времени суток.)
У меня проблема следующая. Необходимо суммировать данные 14 листов, расположенные в 14 книгах в диапазоне C14:N25/ Суммировать нужно часть книг, результат должен появиться в открытой книге "Итоги", открывать книги при выполнении операции в скрытом режиме
Нашел такой Макрос, но не могу понять что нужно изменить, чтобы он работал по суммированию только определенных книг, и чтобы вносил результат в открытую книгу "Итоги"

Dim Folder As String
Dim wb As String
Dim objWb As Workbook
Dim workWb As Workbook
Dim i As Integer
Dim R, C
Dim Q As Worksheet
Dim REZ()
Dim T()
Application.ScreenUpdating = False
Range("C16:N25").Select
Selection.ClearContents
Range("C16:N25").Select
Set workWb = ActiveWorkbook
REZ = workWb.ActiveSheet.Range(Cells(7, 1), Cells(29, 39)).Value
wb = Dir(workWb.Path & "\*.xlsx")
While Len(wb) > 0 And wb <> Итоги.xls"
wb = workWb.Path & "\" & wb
Set objWb = Workbooks.Open(wb)
For Each Q In objWb.Sheets
Q.Select
m = Q.Range(Cells(7, 1), Cells(29, 39)).Value
For R = 4 To 23
For C = 2 To 39
REZ(R, C) = REZ(R, C) + m(R, C)
Next C
Next R
Next
objWb.Close False
wb = Dir Wend
workWb.ActiveSheet.Range(Cells(7, 1), Cells(29, 39)).Value = REZ
Application.ScreenUpdating = True
MsgBox "Ok", 64, ""
End Sub

Но что то не хочет он работать, кроме того

[doober]

Без примера могу ошибиться,макрос суммирует данные первых листов книг.Я засомневался,что есть 14 книг ,каждая с 14 листами

Sub Сумматор()
    Dim REZ(1 To 12, 1 To 12)   As Double , Sh As Worksheet
    Dim S_Out As Worksheet, Path As String
    Application.ScreenUpdating = False
    Dim НужныеКниги
    НужныеКниги = Array("Вася.xls", "Петя.xls", "Коля.xls")

    Dim oFS: Set oFS = CreateObject("Scripting.FileSystemObject")
    Set S_Out = ActiveSheet
    Path = S_Out.Parent.Path
    On Error Resume Next
    For l = 0 To UBound(НужныеКниги)
        Filename = Path & "\" & НужныеКниги(l)
        If oFS.FileExists(Filename) Then
            Set Sh = GetObject(Filename).Worksheets(1)
            X = Sh.Range("C14:N25").Value
            For n = 1 To 12
                For i = 1 To 12
                    REZ(n, i) = REZ(n, i) + X(n, i)

                Next
            Next
            Sh.Parent.Close (False)
        End If

    Next
    Set oFS = Nothing
    S_Out.Range("C14").Resize(12, 12) = REZ  
    Application.ScreenUpdating = True
    MsgBox "Ok", 64, ""
End Sub

[SAS888]

Если имена всех листов книг, из которых требуется получить данные, известны (или вообще одинаковые), то все можно сделать и вовсе не открывая файлов-источников.
Например, пусть листы с данными называются "Лист1" и требуемые файлы находятся в той же папке, где файл с этим макросом.

Sub Main()
    Dim x As Range, ws As Worksheet, p As String
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Set ws = Sheets("Итоги"): Set x = ws.[C14:N25]: x.ClearContents
    Sheets.Add.Name = "Temp": p = ThisWorkbook.Path & "\"
    For Each f In Array("Вася.xls", "Петя.xls", "Коля.xls") 'нужные файлы
        With Range(x.Address)
            .ClearContents
            .Formula = "='" & p & "[" & f & "]Лист1'!" & x.Address
            .Copy
            x.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
        End With
    Next
    ActiveSheet.Delete: x.Value = x.Value: Application.CutCopyMode = False
End Sub

Если нужно, добавьте проверки на предмет существования искомых файлов и листов.

[Extril]

Спасибо большое, только почему то не срабатывает последний скрипт, подсвечивает наименование в строке Set ws = Sheets("Итоги") подсвечивает "Итоги". Может быть это потому что путь где лежат файлы слишком длинный \\nwdata.nw.mmm.ru\DavWWWRoot\sites \ur_dep\DocLib\юристы\

[IgorGO]

это потому, что названия листов и книг здесь вымышленны:
Sheets("Итоги")
"Вася.xls",
"Петя.xls",
"Коля.xls"

рассматривайте это не как готовый код, а как заготовку. вооружитесь напильником и допиливайте пока не начнет работать или пока волдыри на клавиатуре не появятся.

[SAS888]

в строке Set ws = Sheets("Итоги") подсвечивает "Итоги"

Подразумевается, что в открытой книге, содержащей этот код, имеется лист с именем "Итоги", на который и будут помещаться данные. Измените в коде имя листа на требуемое.
Можно поступить так же, как предлагает doober, т. е. присвоить

Set ws = ActiveSheet

Но, в этом случае, макрос потребуется запускать только в тот момент, когда активным является лист, на который требуется собрать данные.

[Extril]

Итак, у меня есть папка "Temp", в которой книга "Аналитика", содержащая лист "ИТОГИ" и диапазон B3:N25 в который должны подставиться результаты суммирования других книг. Для суммирования берутся листы "Итоги" из книг "Вася.xlsx", "Петя.xlsx" (диапазон B3:N25 ), в итоге у меня заработал такой скрипт.

Private Sub CommandButton1_Click()
Dim x As Range, ws As Worksheet, p As String
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Set ws = Sheets("ИТОГИ"): Set x = ws.[B3:N25]: x.ClearContents
Sheets.Add.Name = "Temp": p = ThisWorkbook.Path & "\"
For Each f In Array("Вася.xlsx", "Петя.xlsx") 'нужные файлы
With Range(x.Address)
.ClearContents
.Formula = "='" & p & "[" & f & "]Итоги'!" & x.Address
.Copy
x.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
End With
Next
ActiveSheet.Delete: x.Value = x.Value: Application.CutCopyMode = False
End Sub

При суммировании появляются очень странные цифры, похоже что формула содержит ошибку, вот только какую неясно окончательно. Но хоть убей не считает она.

[SAS888]

При суммировании появляются очень странные цифры, похоже что формула содержит ошибку, вот только какую неясно окончательно.

Макрос работает так: Создается временный вспомогательный лист. В требуемом диапазоне этого листа создаются ссылки на этот же диапазон листа "Итоги" текущего в цикле файла. Затем, с помощью специальной вставки, значения этого диапазона суммируются с значениями соответствующего диапазона листа "ИТОГИ" в этом файле. После цикла по всем нужным файлам, временный лист удаляется.
Какие могут быть ошибки? Единственное, что можно предположить, это то, что значения в суммируемых диапазонах файлов-источников имеют нечисловой формат (например, текстовый).
Попробуйте в код добавить следующее:

Private Sub CommandButton1_Click()
    Dim x As Range, ws As Worksheet, p As String
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Set ws = Sheets("ИТОГИ"): Set x = ws.[B3:N25]: x.ClearContents
    Sheets.Add.Name = "Temp": p = ThisWorkbook.Path & "\"
    For Each f In Array("Вася.xlsx", "Петя.xlsx") 'нужные файлы
        With Range(x.Address)
            .ClearContents
            .Formula = "='" & p & "[" & f & "]Итоги'!" & x.Address
            arr = .Value: .NumberFormat = "General": .Value = arr
            .Copy
            x.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
        End With
    Next
    ActiveSheet.Delete: x.Value = x.Value: Application.CutCopyMode = False
End Sub

Для однозначного выяснения проблемы, прикрепите файл с макросом и пару файлов источников.

[Extril]

Выкладываю пример файлов,

[Extril]

Сорри, не прикрепилось с первого раза