VBA: объединение файлов Excel из нескольких папок в один рабочий лист на основе одинаковых первых 4 символов в имени файла.xlsx
Описание:
Есть файлы с идентификатором клиента от 001 до 100. У каждого клиента есть 3 разных отчета Excel (### Report1-3), которые генерируются в разных папках (Folders1-3).
Например: Папка 1 будет иметь:
001 Report1.xlsx
...
100 Report1.xlsx
Папка 2 будет содержать:
001 Report2.xlsx
...
100 Report2.xlsx
Папка 3 будет содержать:
001 Report3.xlsx
...
100 Report3.xlsx
Каждый из этих файлов содержит только один лист со значениями (без формул и сводных таблиц). Каждый отчет 1, отчет 2, отчет 3 имеет разный набор столбцов/строк.
Вопрос:
Я хотел бы создать одну рабочую книгу для каждого идентификатора клиента "###" и иметь отчеты в виде листов (### Отчет1) (### Отчет 2) (### Отчет 3) (Все требуемые документы, которые необходимо объединить в одну рабочую книгу, будут иметь первые четыре символа в начале имени каждого отчета)
Например, для Customer: 001
Создайте одну рабочую книгу «001 AllReports.xlsx», которая содержит:
Лист 1 = 001 Report1
Лист 2 = 001 Report2
Лист 3 = 001 Report3
Затем перейдите к идентификатору клиента 002 и сделайте то же самое.
Пожалуйста, дайте мне знать, если что-то еще нужно прояснить. Спасибо, я действительно это ценю!
Некоторые заметки/мысли:
Я думал о создании шаблона Merger Macro с 3 полями. Где я заполняю пути Folder 1, затем Folder 2 и Folder 3, а затем продолжаю объединять документы на основе идентификатора клиента.
Для объединения основных файлов я использовал: https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.copy
Мне также было интересно сделать это с помощью запроса, но поскольку столбцы в Report1-3 не согласованы, я не уверен, будет ли это вообще возможным вариантом.
Этот пример/VBA хорош, если все файлы находятся в одной папке: было бы здорово добавить разные пути к папкам и основывать их на именах, содержащих идентификатор клиента ###.
Sub ConslidateWorkbooks()
'Created by Sumit Bansal from https://trumpexcel.com
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "\Desktop\Test\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub