автоматическая подгрузка данных нескольких файлов в одну сводную

[Serge 007]

Буду золотить далее!)

[Dimchiko]

Золочение - золочением, но я так и не понял - а как засунуть в сводную не все данные с листа "КП", а только лишь с одного диапазона в этом листе? Скажем - с именнованого диапазона всегда разного размера?
Просто в любом КП сверху есть "шапка", а в конце подпись. Это лишняя информация просто...

[Serge 007]

в любом КП сверху есть "шапка", а в конце подпись

Я должен был об этом догадаться?
В файлах-примерах об этом ни слова

[Dimchiko]

4) в каждом листе КП есть один диапазон, данные из которых надо занести в общую сводную

[Татьянка]

4) в каждом листе КП есть один диапазон, данные из которых надо занести в общую сводную

Dimchiko, а разве макрос Serge 007 работает не так?
Я попробовала на ваших файлах - в них ни шапки, ни подписи нет, копируется весь диапазон

[Dimchiko]

Копируется весь лист.
Это тоже классно!
Я просто доработаю код.

[Татьянка]

Копируется весь лист

Копируется указанный диапазон, а не весь лист
По крайней мере, у меня так

[Serge 007]

в любом КП сверху есть "шапка", а в конце подпись

Dimchiko, предположим что в каждой смете шапка занимает одну первую строку, а подпись - две последних строки
Что бы они не попадали в свод замените в моем макросе строку

Код Выделить Развернуть

.Range(.Cells(1, 1), .Cells(iLRTempWb, 4)).Copyна

Код Выделить Развернуть

.Range(.Cells(2, 1), .Cells(iLRTempWb - 2, 4)).Copy

[Dimchiko]

Добрый день!
В целом код делает то, что должен.
я его оставил в такой редакции:

Код Выделить Развернуть

Private Sub Workbook_Open()

Dim BazaWb As Workbook 'сводный файл
Dim BazaSht As Worksheet 'сводный лист
Dim iFileName$ 'имя каждой сметы (по очереди)
Dim iPath$ 'путь к папке, где лежат все сметы
Dim iLRBaza& 'последняя заполненная строка в сводном файле (в столбце A)
Dim iLRTempWb& 'последняя заполненная строка в каждой из смет (в столбце A)
Dim iNumFiles& 'количество смет
    With Application
   
    Rows("1:10000").Delete
    ActiveSheet.UsedRange.Clear
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlManual
        On Error Resume Next
        Set BazaWb = ThisWorkbook
        Set BazaSht = BazaWb.Sheets("Итог")
        iPath = BazaWb.Path & "\"
        iFileName = Dir(iPath & "*.xls")
        Do While iFileName <> ""
            If iFileName <> BazaWb.Name Then
                With .Workbooks.Open _
                    (Filename:=iPath & iFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    With .Worksheets("КП")
                            iLRTempWb = .Cells(Rows.Count, 1).End(xlUp).Row - 21 'последняя строка в смете
                            iLRBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row 'последняя строка в базе
                            BazaSht.Cells(iLRBaza + 3, 1) = iFileName
                         .Range(.Cells(16, 1), .Cells(iLRTempWb, 6)).Copy 'Destination:=BazaSht.Cells(iLRBaza + 2, 1)
                          BazaSht.Cells(iLRBaza + 3, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
                    End With
                    .Close saveChanges:=False
                End With
            End If
            iFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Данные собраны из " & iNumFiles & " смет", vbInformation, "Сбор данных смет окончен"

End Sub  Проблема выявилась странная...
Если делаю Copy Destination и сохраняю координаты начала и конца - все работает как надо: происходит вставка ЗНАЧЕНИЙ с сохранением ФОРМАТА сметы. Если координату меняю более чем на 1, то сохраняется ФОРМАТ, но вставляются данные вперемежку с формулами...
Вообще не понял, почему так происходит...

[Serge 007]

В листинге, который Вы привели сейчас, вставляются только значения Paste:=xlPasteValues (за это отвечает метод PasteSpecial)
Строка 'Destination:= закомментирована, т.е. в коде не участвует и формулы и/или форматы вставить код не имеет возможности, даже теоретической

[Dimchiko]

Serge 007, так я и говорю: это происходит если даже я убираю комментирование и делаю Copy Destination...
По идее должен срабатывать подход, когда сначала идет вставка с формулами и форматом, а затем повторная вставка только значений. Пробовал...такое ощущение, что второй раз ничего не вставилось...

[Serge 007]

если даже я убираю комментирование и делаю Copy Destination

В этом случае будут вставляться и формулы, и форматы
Но тогда надо закомментировать следующую строку
Или привести её в соответствие с предыдущей (не должно быть в одной строке iLRBaza + 2, а в другой iLRBaza + 3, как в Вашем листинге)

PS

Код Выделить Развернуть

, Operation:=xlNone, SkipBlanks:=False, Transpose:=False - это не нужно

[Dimchiko]

Хоть убейте - не понимаю!

Код Выделить Развернуть

.Range(.Cells(1, 1), .Cells(iLRTempWb, 6)).Copy Destination:=BazaSht.Cells(iLRBaza + 2, 1)
       BazaSht.Cells(iLRBaza, 1).PasteSpecial Paste:=xlPasteValues - вставляет все данные так как нужно (форматы и ТОЛЬКО ЗНАЧЕНИЯ, без формул), но - с лишними данными сверху (с шапкой).

Корректирую координаты и

Код Выделить Развернуть

.Range(.Cells(16, 1), .Cells(iLRTempWb, 6)).Copy Destination:=BazaSht.Cells(iLRBaza + 2, 1)
       BazaSht.Cells(iLRBaza, 1).PasteSpecial Paste:=xlPasteValues - вставляет все данные с нужным ФОРМАТОМ, но еще дополнительно, почему-то С ФОРМУЛАМИ! Как это может быть?

[Serge 007]

Как это может быть?

Никак
Однако строки, которые вы приводите в качестве примера - некорректны
Например здесь:

Код Выделить Развернуть

Destination:=BazaSht.Cells(iLRBaza + 2, 1)Вы вставляете формулы и форматы на две строки НИЖЕ ПОСЛЕДНЕЙ строки общего файла, а здесь

Код Выделить Развернуть

BazaSht.Cells(iLRBaza, 1).PasteSpecial Paste:=xlPasteValues уже вставляете только значения начиная непосредственно с ПОСЛЕДНЕЙ строки общего файла

Ещё раз рекомендую:

надо закомментировать следующую строку
Или привести её в соответствие с предыдущей (не должно быть в одной строке iLRBaza + 2, а в другой iLRBaza + 3, как в Вашем листинге)