объединить несколько листов из разных рабочих книг (в 1 файле) в рабочую книгу, содержащую 1 лист «sheet1»

Question

Идея состоит в том, чтобы объединить все листы1, находящиеся в рабочих книгах, которые находятся в файле "Filepath", с рабочими книгами, лист "Summary" все файлы имеют одинаковый заголовок, поэтому нет необходимости копировать за заголовок Пример: 2 файла

Настоящим мой код, который мне удается набрать:

Sub collate_data()
Dim folderpath As String
Dim filepath As String
Dim filename As String
Dim final As String



folderpath = ThisWorkbook.Sheets("input").Cells(1, 2).Text
filepath = folderpath & "*xlsx*"
filename = Dir(filepath)
smer = ThisWorkbook.Sheets("input").Cells(3, 2).Text
Dim lastrow As Long
Dim lastcolumn As Long

Do While filename <> ""
final = ThisWorkbook.Sheets("input").Cells(6, 2).Text
 y = final & "Summary.xlsx"

Workbooks.Open (folderpath & filename)

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlDown).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Select
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

Set x = Workbooks.Open(smer)
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste = Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 1))


filename = Dir
Loop
Application.DisplayAlerts = True


End Sub

Answer 1

В вашем коде есть некоторые недостатки. Например, когда вы назначаете lastrow, вы помещаете ячейку в последнюю строку (rows.count), а затем заканчиваете (xlDown), которая останется в последней строке. Это должно быть конец (xlUp), если вы собираетесь получить последнюю использованную строку в столбце 1. Та же проблема касается последнего столбца.

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

Dim fs, f, files, curfile
Dim i As Integer

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(path-to-folder)
Set files = f.Files
i = 5

For Each curfile In files
   ... whatever you need to be done with every file ...
Next

Также при вставке данных сначала нужно выбрать левый верхний угол, а затем сделать Activesheet.Paste. В этом случае:

x.Worksheets("sheet1").Cells(erow, 1).Select
ActiveSheet.Paste

Но имейте в виду, что вы закрываете источник данных, вставляемых перед фактическим вставлением, а также что на каждой итерации цикла вы открываете файл назначения (smer), что приведет к ошибке. Этот файл назначения должен быть уже открыт к началу цикла.

Надеюсь, это поможет вашей работе