Top.Mail.Ru
Ответы

Подскажите макрос, чтобы объединить данные из разных файлов excel на 1 лист

Есть около 50 файлов. В каждом файле 1 лист с одинаковым набором столбцов, только с разным количеством строк. Нужно скопировать из всех этих файлов все данные, кроме заголовка (он одинаковый у всех) в отдельный файл на один лист, и добавить в столбце справа название файла, из которого копировали

По дате
По рейтингу
Аватар пользователя
Просветленный
3мес

Например :
https://www.planetaexcel.ru/techniques/12/2152/

Аватар пользователя
Мыслитель
3мес

если Excel не очень старый можно использовать надстройку PowerQuery: "Создать запрос" -> "Из файла" -> "Из папки".

Аватар пользователя
Мыслитель
3мес

ИИ говорит о вот таком вот способе решения задачи:

Вот пошаговое решение вашей задачи:

1. Создайте новый файл Excel, который будет служить целевым для объединения данных

2. В целевом файле:
- На первом листе в первую строку введите заголовки столбцов (как в исходных файлах)
- Оставьте вторую строку пустой для начала данных

3. Для копирования данных из каждого файла:
- Откройте исходный файл
- Выделите диапазон с данными (без заголовка)
- Скопируйте выделенный диапазон (Ctrl+C)
- Перейдите в целевой файл
- Установите курсор в последнюю заполненную строку + 1
- Вставьте данные (Ctrl+V)

4. После вставки данных из каждого файла:
- В пустой столбец справа введите название файла
- Можно использовать формулу =RIGHT(CELL("filename"),LEN(CELL("filename"))-FIND("]",CELL("filename")))
для автоматического получения имени файла

5. Для автоматизации процесса можно использовать VBA-код:

1234567891011121314151617181920212223
 Sub ОбъединитьФайлы() 
    Dim папка As String, файл As String 
    Dim i As Integer 
     
    папка = "C:\Ваша\Папка\" 'Укажите путь к папке с файлами 
    файл = Dir(папка & "*.xlsx") 
     
    i = 2 'Начальная строка для записи данных 
     
    While файл <> "" 
        With ActiveSheet 
            Range("A" & i).Value = файл 
            Workbooks.Open (папка & файл) 
            With Workbooks(файл).Sheets(1) 
                .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Copy _ 
                    Destination:=ThisWorkbook.Sheets(1).Range("A" & i) 
                i = i + .Range("A" & Rows.Count).End(xlUp).Row - 1 
                Workbooks(файл).Close False 
            End With 
        End With 
        файл = Dir 
    Wend 
End Sub 

6. После завершения копирования:
- Отформатируйте объединенные данные
- При необходимости отсортируйте их
- Добавьте фильтры для удобства работы

7. Сохраните файл как .xlsx или .xlsm (если использовались макросы)

Теперь у вас будет один файл со всеми данными из 50 исходных файлов, где в правом столбце указано, из какого файла взяты данные.