Страницы: 1
RSS
Объединение всех листов из файла на один
 
Коллеги, привет!

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

Уже искал по архиву и по разным темам - все очень близко, но не то. Знаю как решить надстройками и power query, а вот знания VBA безнадежно устарели, и самостоятельно не выходит. А нужно именно на VBA. Пример 1-ого файла во вложении.

Большое спасибо!
 
Цитата
ide написал:
Столкнулся с интересной задачей
И чем же она интересна? Подобные темы время от времени появляются на форуме.
В "Приемы" заходили? Вот статья, которая может Вам помочь.
 
ide, А еще бы было неплохо показать результат что должно получится после работы макроса...
Не бойтесь совершенства. Вам его не достичь.
 
Результат описал выше в посте #4

Именно этот макрос я использовал, но не смог его доделать до конца.
Он сейчас копирует все из исходной книги, а я хочу сделать:
1. Отдельный файл ("Макрос"), где при запуске макроса будет всплывающее окно с выбором файла
2. Из выбранного файла все листы будут сливаться на первый лист в файл "Макрос"
 
ide, Ваши сообщения скрывает антиспам. вероятно из-за того, что Вы увлекаетесь цитированием.
М в #4 нет никакого результата.
 
Странно, у меня вот так все отображается.
 
И где в #4 пример того, как должен выглядеть результат?
Открыл два скрытых сообщения - смотрите теперь.
 
Юрий М, Прикладываю два файла:
1. "Исходный файл1" - данные по продажам
2.  "Макрос" - итоговый файл с макросом и следующей логикой (которую никак не могу доработать): Запускаем макрос по кнопке, далее предлагается выбрать файл (в нашем случае выбираем "Исходный файл1"), далее все листы из "Исходный файл1" копируются в файл "Макрос" на лист "Сводный".
 
Цитата
ide написал:
Все листы из выбранного файла схлопываются в один
Цитата
ide написал:
все листы будут сливаться на первый лист
Ну вот, наконец-то стало ясно для чего был создан Excel - для подтверждения теории создания Вселенной (от сингулярности до бесконечности - периодические расширения и схлопывания  :)
Цитата
ide написал:
Именно этот макрос я использовал
К сожалению, после изначального расширения (или схлопывания)  в #1  в xlsx человечеству суждено об этом макросе только догадываться...
ide, не сердитесь и не обижайтесь, иногда здесь любят пошутить, но гораздо чаще помогают. Обратие внимание на Правила форума и #3 в этой теме
P.S. Не видел приложенные файлы - не все сообщения было видно. И еще три темы сегодня сначала появились, потом исчезли, потом снова появились - наверное с сайтом какие-то неполадки..
Изменено: _Igor_61 - 26.05.2020 20:17:42
 
_Igor_61,

Я и не обижаюсь, просто прошу помощи в чем сам за весь день не смог разобраться :)

Задачку эту уже давно решил с помощью Power Query и в Power BI тоже. Там все более эстетично. Однако есть потребность именно в макросе, а в них я увы не силен.
 
Не знаю как насчет эстетики... Если имеете ввиду форматирование ячеек и текста - то это отдельная тема. Файлы должны быть в одной папке.
 
_Igor_61, Спасибо, но пока что вот так. Оба файла в одной папке.
 
Не знаю, у меня все работает
 
Проверил, у меня работает
 
_Igor_61, bagdasarov86, как не работало, так и нет, пробовал на своеим компе и на рабочем и в разных версиях. Ну да бог с ним. Главное я понял принцип, думаю справлюсь.

Если брать вот этот пример https://www.planetaexcel.ru/techniques/12/7453/ - в части где VBA есть возможность добавить копирование названия столбца? У меня в файле названия листов соответствуют месяцам, было бы неплохо иметь фильтр по ним.
 
В том примере:
Код
'копируем на итоговый лист шапку таблицы из первого листа
    wbCurrent.Worksheets(1).Range("A1:D1").Copy Destination:=wbReport.Worksheets(1).Range("A1")
В Вашем примере нет в шапке столбца "Месяц", но на листе "Декабрь" месяц записан в столбце "Комментарий". Можете там и записывать месяцы для фильтра, или добавьте на всех листах еще столбец "J" (Месяц) и в этот столбец при заполнении вписывайте название листа во все ячейки, тогда в макросе будет
Код
wbCurrent.Worksheets(1).Range("A1:J1").Copy Destination:=wbReport.Worksheets(1).Range("A1") 'шапка из "Исходный файл1.xlsx"
И по этому столбцу будете фильтровать.
Можно добавить в макрос чтобы название месяца автоматически записывалось  в таблицу по названию листа в исходном файле, но это уже другой вопрос, для него нужно будет создать отдельную тему.
Ошибка 1004 у Вас возникает вероятно потому что запускаете макрос при открытом файле "Исходный файл1".
Попробуйте запускать макрос либо при закрытом исходном файле либо добавьте в начало макроса
Код
Application.DisplayAlerts = False
и в конце
Код
Application.DisplayAlerts = True
Изменено: _Igor_61 - 27.05.2020 07:19:06
 
Код
Sub CollectDataFromAllSheets()
    Dim mainsh As Worksheet
    Dim tvinkbook As Workbook
    Dim sht As Worksheet
    Dim arr(), mrow&, trow&, i&, ipath$
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set mainsh = ThisWorkbook.ActiveSheet
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show Then ipath = .SelectedItems(1) Else Exit Sub
    End With
    With GetObject(ipath)
        For Each sht In .Worksheets
            mrow = mainsh.Range("a" & mainsh.Rows.Count).End(xlUp).Row + 1
            trow = sht.Range("a" & sht.Rows.Count).End(xlUp).Row
            arr = sht.Range("a2:i" & trow).Value
            mainsh.Range("a" & mrow).Resize(UBound(arr), UBound(arr, 2)).Value = arr
            Erase arr
        Next sht
        .Close False
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, Огромное спасибо! То, что было нужно.
 
Цитата
ide написал:
а) Всплывающее окно выбора файла (тип эксель)
"Слона-то я и не приметил..."(©),  а лишь второй вопрос заметил :)  Но все равно не понятно почему макрос у ТС-а не сработал... Тайна...
Изменено: _Igor_61 - 29.05.2020 20:24:49
Страницы: 1
Наверх