Вывод необходимой информации из ста+ разных листов в один

[uncredow]

Добрый день!

Уважаемые эксперты, подскажите, пожалуйста как можно реализовать в excel следующие действия:

К примеру:
Имеется:
1. Один файл со ста разными листами
2. Каждый лист является отдельным расчетом кадастровых работ по определенной улице.
3. В каждом листе есть итог (фраза в ячейке - "Итого по смете:"), который может находиться из-за криворукости исполнителей в разных ячейках:
-Лист 1 ячейка E19
-Лист 2 ячейка D23
-Лист 3 ячейка F409
и тд.

Нужно:
1. Чтобы искал во всех листах книги значение ячейки "Итого по смете"
2. Сводил найденные данные в новый лист построчно, начиная с ячейки где текст "Итого по смете" и двадцать ячеек из каждого листа , которые на этой же строке.

Есть небольшой макрос, но в нем проблема:
1. Ищет исключительно в столбцах A и B
2. Вносит данные из строки только 11 ячеек.
3. Если данные после ячейки "Итого по смете" повторяются, то еще одна строка в новом листе не добавляется.
4. Если на листе сразу два адреса с ячейкой "Итого по смете", то он переносит только первую строку, игнорируя вторую.


Я в этом не очень силен, прошу вашей помощи, таких файлов прилетело порядка 400 штук, в которых по 100-200 листов.
Вручную копировать мизинец с указательном пальцем немеют, а через макрос то и дело бывает, что на разные адреса итоговая смета с одинаковыми данными.

Sub собрать()
  Dim Dic As Object, i&, j&, Row&, cRow&, cCol&, tmp, s$
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.comparemode = 1
    cCol = Sheets.Count + 10
    ReDim mas(1 To 999, 1 To cCol)
    For i = 12 To cCol
        With Sheets(i - 11)
            tmp = .Range(.Cells.Find("Всего по смете").Offset(1), .Cells(Rows.Count, 12).End(xlUp)).Value
        End With
        For Row = 1 To UBound(tmp)
            s = tmp(Row, 1) & "|" & tmp(Row, 2) & "|" & tmp(Row, 3) & "|" & tmp(Row, 4) & "|" & _
                    tmp(Row, 5) & "|" & tmp(Row, 6) & "|" & tmp(Row, 7) & "|" & tmp(Row, 8)
            If Dic.exists(s) = False Then
                cRow = cRow + 1
                If cRow Mod 1000 = 0 Then ReDim Preserve mas(1 To cRow + 999, 1 To cCol)
                Dic(s) = cRow
                mas(cRow, 1) = cRow
                For j = 2 To 11: mas(cRow, j) = tmp(Row, j - 1): Next
            End If
            mas(Dic(s), i) = tmp(Row, 11)
        Next
    Next
    With Sheets(Sheets.Count).Cells(7, 1).Resize(cRow, cCol)
        .Value = mas
        .Borders.LineStyle = 1
    End With
End Sub

[IgorGO]

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

и если уже говорить об автоматизации процесса, то открыть 400 файлов и в каждом запустить макрос - это тоже работа! причем это такая работа, когда открыв 97-й файл Вы начинаете сомневаться, а не пропустил-ли я 96-й? не остался ли он не обсчитанным? и эта мысль будет появляться стабильно все чаще по мере обработки файлов.

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