CODEWITHSUNDEEP
vbaexcelmerge
ilyes
ilyes

Reputation: 55

merge several sheets from different workbooks (in 1 file) to workbook which contain 1 sheet "sheets1"

The idea is to merge all sheets1 which are in workbooks which are located in file "Filepath" to workbooks , sheet "Summary" all files having the same header so there is no a need to copy past the header Ex : 2 files enter image description here

Hereby my code which I manage to type : 

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

Upvotes: 2

Views: 65

Answers (1)

Sama Tori
Sama Tori

Reputation: 141

There's some flaws in your code. For example, when you assign lastrow, you position the cell in last row (rows.count) and then end(xlDown), which will remain in last row. That should be end(xlUp) if you intend to get the last used row in column 1. The same issue goes for lastcolumn.

Also, I don't see how filename is going to change with every iteration. I normally do the following if I want to iterate a list of files within a directory:

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

Also, when pasting the data you have to first select the upper left corner, and then do Activesheet.Paste. In this case:

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

But bear in mind that you are closing the source of the data being pasted before the actual pasting, and also that every iteration of the loop you are opening the destination file (smer), which will result in error. That destination file should be already open when the loop begins.

Hope this helps for your workings

Upvotes: 1

Related Questions