Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Office Новый топик    Ответить
 Объединение листов из нескольких книг в одну.  [new]
Kseniya_T
Guest
Существует несколько однотипных книг, по двадцать листов в каждой, лежащие в одной папке.

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

Помогите, пожалуйста, реализовать это на VBA, а то вручную очень-очень трудоёмко!

Например, непонятно, как копировать с каждого листа всю содержащуюся информацию, т.к. она состоит из нескольких диапазонов?

Как перебирать файлы из каталога?
5 дек 08, 18:11    [6532428]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Kseniya_T
Guest
Помогите, пожалуйста!
Нашла примеры поиска последней ячейки https://www.sql.ru/forum/actualthread.aspx?bid=46&tid=396213
но какой применить для своей задачи точно не знаю.

А как с перебором файлов?

И как же реализовать все целиком??

Помогите, пожалуйста... а то со временем совсем тяжко((
9 дек 08, 17:57    [6546933]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Pavel55
Member

Откуда: Moscow
Сообщений: 324
См. пример

К сообщению приложен файл (Example_1.rar - 25Kb) cкачать
10 дек 08, 00:20    [6548069]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Pavel55
Member

Откуда: Moscow
Сообщений: 324
См. пример 2 (не помню, чем они отличаются)

К сообщению приложен файл (Example_2.rar - 60Kb) cкачать
10 дек 08, 00:21    [6548073]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Kseniya_T
Guest
Спасибо за примеры, но подскажите пожалуйста, как изменить код, чтобы обеспечить условие накопительного копирования не с одного, а с каждого листа исходных книг в общую книгу (разделенных парой пустых строк)?

Option Explicit

Sub CollectInfo()
Dim BazaWb As Workbook 'текущая книга (общий файл)
Dim BazaSht As Worksheet 'лист Price-group в общем файле
Dim iTempFileName As String 'имя поочерёдно открываемого файла
Dim iPath As String 'путь к папке, где лежат все файлы
Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле в столбце C
Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очерёдно открываемом файле в столбце C
Dim iNumFiles As Long 'количество открываемых файлов

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlManual
        Set BazaWb = ThisWorkbook
        Set BazaSht = BazaWb.Sheets("Price-group")
        iPath = BazaWb.Path & "\"
        iTempFileName = Dir(iPath & "*.xls")
        Do While iTempFileName <> ""
            If iTempFileName <> BazaWb.Name Then
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                     iNumFiles = iNumFiles + 1
                     'Рабочая книга не должна быть защищена паролем
                     With .Worksheets(1)
                          iLastRowTempWb = .Cells(Rows.Count, 3).End(xlUp).Row
                          iLastRowBaza = BazaSht.Cells(Rows.Count, 3).End(xlUp).Row + 1
                          .Range(.Cells(9, 1), .Cells(iLastRowTempWb, "P")).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
                     End With
                     .Close saveChanges:=False
                End With
            End If
            iTempFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"
End Sub
21 дек 08, 20:15    [6600195]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Pavel55
Member

Откуда: Moscow
Сообщений: 324
Сложно писать макрос, не видя ваших файлов. Поэтому вам самой придётся корректировать его под свои файлы.
Вот пример макроса, который будет открывать каждый файл и копировать информацию с каждого листа один под другим с разрывом в 2 строки. Каждый лист - отдельный файл со множеством листов


Sub CollectInfo()
Dim BazaWb As Workbook 'книга с макросом (общий файл)
Dim BazaSht As Worksheet 'лист в общем файле куда будем копировать
Dim iTempFileName As String 'имя поочерёдно открываемого файла
Dim iPath As String 'путь к папке, где лежат все файлы
Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле
Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очерёдно открываемом файле
Dim iNumFiles As Long 'количество открываемых файлов
Dim TempSht As Worksheet 'каждый лист в открываемых файлах

    If MsgBox("Скопировать информацию из всех файлов в текущей папке в данный файл?", vbOKCancel + vbQuestion, _
        "Копирование инфо") = vbCancel Then Exit Sub
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlManual
        .ShowWindowsInTaskbar = False
        Set BazaWb = ThisWorkbook
        iPath = BazaWb.Path & "\"
        iTempFileName = Dir(iPath & "*.xls")
        Do While iTempFileName <> ""
            If iTempFileName <> BazaWb.Name Then
                Set BazaSht = BazaWb.Sheets.Add
                On Error Resume Next
                BazaWb.Sheets(Left(iTempFileName, Len(iTempFileName) - 4)).Delete
                On Error GoTo 0
                BazaSht.Name = Left(iTempFileName, Len(iTempFileName) - 4)
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    For Each TempSht In .Worksheets
                        iLastRowBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row + 3
                        With TempSht
                            iLastRowTempWb = .Cells(Rows.Count, 1).End(xlUp).Row
                            'копируем диапазон со столбца А до АС включительно
                            .Range(.Cells(1, 1), .Cells(iLastRowTempWb, "AC")).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
                        End With
                    Next
                    .Close saveChanges:=False
                    BazaSht.Rows("1:3").Delete
                End With
            End If
            iTempFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .ShowWindowsInTaskbar = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Информация скопирована из " & iNumFiles & " файлов!", vbInformation, "Конец"
End Sub
23 дек 08, 13:16    [6607767]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Kseniya_T
Guest
Еще раз огромное спасибо)))
В отчаянии и с замиранием души выкладываю пример своего "сокровища". Здесь типовой файл, названия листов и заголовки на страницах не меняются, меняется "наполнение". Таких файлов, если исходить из того, что в месяц их 4 или 5 штук, а всего у нас 12 месяцев, около 54 штук...
Задача состоит в том, чтобы в итоговый файл страницы добавлялись безо всяких премудростей, т.е. нет необходимости оставлять единую шапку каждого листа и добавлять к ней данные, к примеру, если это таблица. Нет. Нужно просто с самой первой строки листа, и до последней заполненной (в Примере это строка "Директор компании", на всех страницах, кроме последней), добавлять их с разделением в пару строк. Хотя... на счет последней страницы возможны варианты - на тему - как раз оставить единую шапку, т.к. она не меняется, и просто "доращивать" данные... С другой стороны, чувствую, что надо и меру знать;)) и так неудобно уже.... Прям сказка А.С. Пушкина вспоминается про "Золотую рыбку", ненасытность супруги старца, до добра не довела))), но все же, очень надеюсь на помощь!!!
Кстати, с праздниками всех! Прошедшими и наступающими!!! Всего самого-самого прекрасного, замечательного и доброго! А главное - крепкого здоровья!

К сообщению приложен файл (Пример.zip - 33Kb) cкачать
5 янв 09, 20:01    [6649264]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Pavel55
Member

Откуда: Moscow
Сообщений: 324
Если честно, то я ничего не понял, кроме ваших поздравлений и пожеланий )

Я написал макрос, посмотрите подойдёт ли он вам.
В архиве 4 файла
1) Общий файл - макрос.xls
2) Файл1.xls - для тестирования макроса
3) Файл2.xls - для тестирования макроса
4) Файл3.xls - для тестирования макроса

В файле "Общий файл - макрос.xls" - записан макрос "Сбор_инфо_из_всех_файлов", который копирует информацию из всех файлов со всех листов в Общий файл на соответствующие листы. Если в общем файле, случайно не будет листа, который есть в каком-то из файлов, то этот лист будет создан в общем файле.

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


______________________________________________________________
Разрабатываю макросы под заказ.
Email: MacrosForYou собака yandex точка ru

К сообщению приложен файл (Пример.rar - 96Kb) cкачать
7 янв 09, 04:12    [6652765]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Kseniya_T
Guest
Да! да! да! Он работает! Это чудо! Ну, не чудо конечно, а профессиональные знания и умения... Спасибо огромное! Без Вашей помощи мне было бы очень тяжко... Все работает просто замечательно! Вы действительно мне очень помогли! Единственное к чему можно "придраться" - так это к тому, что отсутствующие в Примере листы в общем файле создаются в обратной последовательности. Т.е. самый последний лист из файлов для сбора информации, в общем файле почему-то становится первым, предпоследний вторым, и так далее... а потом идут листы из Примера. Но это на самом деле уже совершенно не важно, важно, что информация консолидируется в один файл из множества так, как нужно.
Спасибо!
10 янв 09, 20:34    [6663585]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
masjanja80
Member

Откуда:
Сообщений: 1
Pavel55, помогите, пожалуйста, вот в таком деле...
Задача примерно такая же, но книги из которых надо обрабатывать материал лежат в разнах папках. Тот код, который разбирался в этой теме подходит для решения проблемы, но... как его исправить с учетом разных папок? вот эта строчка: "iPath = BazaWb.Path & "\"". Я с VBA столкнулась недавно и никак не могу сообразить как указывается путь... Документы лежат на одном диске, в одной папке, но в разных подпапках.
Заренее спасибо...
23 янв 09, 19:02    [6729357]     Ответить | Цитировать Сообщить модератору
Между сообщениями интервал более 1 года.
 Re: Объединение листов из нескольких книг в одну.  [new]
-O_o-
Member

Откуда: Киев
Сообщений: 924
Спасибо за примеры! Очень помогло!!!!
18 июл 11, 13:08    [10988901]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
-Rama-
Member

Откуда:
Сообщений: 2
от [quot Pavel55] "Потестируйте макрос и сообщите подходит ли он вам или нет. Если нет, то что он делает не так, и как именно он должен делать."


Как собрать с расширением .xlsx ?
Так работает iTempFileName = Dir(iPath & "*.xls")
Так не работает iTempFileName = Dir(iPath & "*.xls*")
18 июл 11, 22:06    [10992063]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Djon Player
Member

Откуда: Россия, Республика Коми, Сыктывкар
Сообщений: 782
-Rama-
Как собрать с расширением .xlsx ?
наверно так: iTempFileName = Dir(iPath & "*.xlsx")
19 июл 11, 17:06    [10996224]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
-Rama-
Member

Откуда:
Сообщений: 2
Djon Player
-Rama-
Как собрать с расширением .xlsx ?
наверно так: iTempFileName = Dir(iPath & "*.xlsx")


А если есть файл и .xlsx и .xls ?
19 июл 11, 20:39    [10997161]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Djon Player
Member

Откуда: Россия, Республика Коми, Сыктывкар
Сообщений: 782
-Rama-
Djon Player
пропущено...
наверно так: iTempFileName = Dir(iPath & "*.xlsx")


А если есть файл и .xlsx и .xls ?
код макросов приведенных выше я не изучал, поэтому могу лишь показать как в принципе перебрать весь список файлов соответствующих нужной маске, в нужной директории, например в корне диска C:

Sub main()
 iPath="C:\"

 iTempFileName = Dir(iPath & "*.xls?")
 Do While iTempFileName <> ""
   MsgBox iTempFileName
   iTempFileName = Dir()
 Loop

End Sub

Вместо знака ? можно так-же и * поставить.
Чтобы отсеять файлы с похожими расширениями, но не совсем такими, какие нам надо, можно ещё дополнительно проверять совпадение расширения с нужным значением.
20 июл 11, 00:34    [10997708]     Ответить | Цитировать Сообщить модератору
Между сообщениями интервал более 1 года.
 Re: Объединение листов из нескольких книг в одну.  [new]
Guest1
Member

Откуда: Кристиан Гислер - ТЫ ЛУЧШИЙ !!! :)))
Сообщений: 1319
Pavel55
Сложно писать макрос, не видя ваших файлов. Поэтому вам самой придётся корректировать его под свои файлы.
Вот пример макроса, который будет открывать каждый файл и копировать информацию с каждого листа один под другим с разрывом в 2 строки. Каждый лист - отдельный файл со множеством листов


Sub CollectInfo()
Dim BazaWb As Workbook 'книга с макросом (общий файл)
Dim BazaSht As Worksheet 'лист в общем файле куда будем копировать
Dim iTempFileName As String 'имя поочерёдно открываемого файла
Dim iPath As String 'путь к папке, где лежат все файлы
Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле
Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очерёдно открываемом файле
Dim iNumFiles As Long 'количество открываемых файлов
Dim TempSht As Worksheet 'каждый лист в открываемых файлах

    If MsgBox("Скопировать информацию из всех файлов в текущей папке в данный файл?", vbOKCancel + vbQuestion, _
        "Копирование инфо") = vbCancel Then Exit Sub
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlManual
        .ShowWindowsInTaskbar = False
        Set BazaWb = ThisWorkbook
        iPath = BazaWb.Path & "\"
        iTempFileName = Dir(iPath & "*.xls")
        Do While iTempFileName <> ""
            If iTempFileName <> BazaWb.Name Then
                Set BazaSht = BazaWb.Sheets.Add
                On Error Resume Next
                BazaWb.Sheets(Left(iTempFileName, Len(iTempFileName) - 4)).Delete
                On Error GoTo 0
                BazaSht.Name = Left(iTempFileName, Len(iTempFileName) - 4)
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                    iNumFiles = iNumFiles + 1
                    For Each TempSht In .Worksheets
                        iLastRowBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row + 3
                        With TempSht
                            iLastRowTempWb = .Cells(Rows.Count, 1).End(xlUp).Row
                            'копируем диапазон со столбца А до АС включительно
                            .Range(.Cells(1, 1), .Cells(iLastRowTempWb, "AC")).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
                        End With
                    Next
                    .Close saveChanges:=False
                    BazaSht.Rows("1:3").Delete
                End With
            End If
            iTempFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .ShowWindowsInTaskbar = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Информация скопирована из " & iNumFiles & " файлов!", vbInformation, "Конец"
End Sub



а как убрать разрывы между вставляемыми листами?
попробовала заккомментировать строку iLastRowBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row + 3
выдаёт ошибку
спасибо
24 ноя 15, 20:30    [18467308]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Казанский
Member

Откуда:
Сообщений: 1307
Guest1, замените +3 на +1
25 ноя 15, 00:39    [18468381]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Guest1
Member

Откуда: Кристиан Гислер - ТЫ ЛУЧШИЙ !!! :)))
Сообщений: 1319
Казанский,

+1 не помогло.


Задача такая:
есть 3 файла одной структуры, в каждом 1 лист.
Надо скопировать эти 3 листа из 3-х файлов на 1 лист (идеально шапку оставить только у первого файла).
То есть в результате должно быть 1 шапка и под ней строки из 3-х файлов.

запускаю
1) модуль CollectInfo() - copy все листы в один файл
2) модуль Copy_f_sad1() - copy всё на один лист - образуются между частями 3 пустые строки, мне надо чтобы их не было.

Причём проверено, что они образуются после запуска модуля CollectInfo()

Помогите, пожалуйста, откорректировать CollectInfo(), чтобы 3 пустые строки при объединении на один лист не формировались.
Файлы во вложении
Модуль в файле exportЧ1.xlsm

Спасибо

К сообщению приложен файл (fil.ZIP - 27Kb) cкачать
25 ноя 15, 10:24    [18469169]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Guest1
Member

Откуда: Кристиан Гислер - ТЫ ЛУЧШИЙ !!! :)))
Сообщений: 1319
Получилось, делюсь .... программа во вложении.
Условие задачи в моём предыдущем сообщении.

К сообщению приложен файл (текст.txt - 2Kb) cкачать
25 ноя 15, 15:50    [18471609]     Ответить | Цитировать Сообщить модератору
Между сообщениями интервал более 1 года.
 Re: Объединение листов из нескольких книг в одну.  [new]
overvilko
Member

Откуда:
Сообщений: 1
собираю данные из нескольких однотипных файлов в одну таблицу таким макросом
Sub RECALK_RD()
F_Path = "'D:\14f2018\[f_14f_MO_22018_"
For Each C In Selection
Text = C.Text
If Text Like "" Then GoTo L1

C(1, 2).Formula = "=" + F_Path + Text + "]Лист 1'!$AV$36"
  C(1, 3).Formula = "=" + F_Path + Text + "]Раздел 2'!$C$6"

  C(1, 5).Formula = "=" + F_Path + Text + "]Раздел 2'!$C$7"

   C(1, 7).Formula = "=" + F_Path + Text + "]Раздел 2'!$C$10"
    C(1, 8).Formula = "=" + F_Path + Text + "]Раздел 2'!$C$14"
    
     C(1, 9).Formula = "=" + F_Path + Text + "]Раздел 3'!$C$8"
      C(1, 10).Formula = "=" + F_Path + Text + "]Раздел 3'!$D$8"
       C(1, 11).Formula = "=" + F_Path + Text + "]Раздел 3'!$E$8"
        C(1, 12).Formula = "=" + F_Path + Text + "]Раздел 3'!$C$39"
L1:
Next
End Sub

имя файла файла представляет собой тип отчета "f_14f_MO_" , квартал и год "22018" , код организации его для макроса я выделяю в итоговой таблице

можете подсказать как сделать что бы часть квартал и год запрашивалась бы при запуске макроса или бралась бы из какой нибудь ячейки в итоговом файле
13 дек 18, 16:16    [21763183]     Ответить | Цитировать Сообщить модератору
 Re: Объединение листов из нескольких книг в одну.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 20366
overvilko
запрашивалась бы при запуске макроса
InputBox
13 дек 18, 16:45    [21763223]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Office Ответить