Merge multiple .xls files into one sheet

Question

I have a folder full of .xls files, all the files have the same structure (column names), I wanted the code to open each file in the folder and copy the contents of sheet1 and paste in another excel file into sheet1, open the second file copy and append in sheet 1.

Currently the code I have does this as different sheet

  Sub GetSheets()
  Path = "C:\Users\dt\Desktop\dt kte\"
  Filename = Dir(Path & "*.xls")
  Do While Filename <> ""
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
      For Each Sheet In ActiveWorkbook.Sheets
        Sheet.Copy After:=ThisWorkbook.Sheets(1)
   Next Sheet
    Workbooks(Filename).Close
     Filename = Dir()
   Loop
End Sub

So you want all the data from the opened workbooks in one sheet in the master workbook ? Instead of copying the entire sheet, you should acces the UsedRange property of the sheets object and copy that to the next empty line on the master sheet, that you want to contain all the data. — Vulthil, Dec 07 '15 at 07:40
Do NOT use `UsedRange`, it is highly unreliable, see here you to find the last cell : http://stackoverflow.com/a/11169920/4628637 — R3uK, Dec 07 '15 at 07:46
I wouldn't use UsedRange either, but I was just trying to point in the right direction. — Vulthil, Dec 07 '15 at 07:51
I would suggest the [Range.CurrentRegion property](https://msdn.microsoft.com/en-us/library/office/ff196678.aspx) as an alternative to the [Worksheet.UsedRange property](https://msdn.microsoft.com/en-us/library/office/ff840732.aspx) but it depends upon the data containing any full blank rows or columns halting the expansion of the current region from A1. — , Dec 07 '15 at 07:59
I found what I was looking for, there is a fantastic add in already created, please check the below answer: [http://superuser.com/questions/304899/how-can-i-merge-hundreds-of-excel-spreadsheet-files](http://superuser.com/questions/304899/how-can-i-merge-hundreds-of-excel-spreadsheet-files) — Anubhav Dikshit, Dec 07 '15 at 07:49

R3uK · Accepted Answer · 2018-11-19T09:52:33.750

This should do the trick :

Sub GetSheets()
Dim WriteRow As Long, _
    LastCell As Range, _
    WbDest As Workbook, _
    WbSrc As Workbook, _
    WsDest As Worksheet, _
    WsSrc As Worksheet

Set WbDest = ThisWorkbook
Set WsDest = WbDest.Sheets.Add
WsDest.Cells(1, 1) = "Set your headers here"

Path = "C:\Users\dt\Desktop\dt kte\"
Filename = Dir(Path & "*.xls")

Do While Filename <> ""
    Set WbSrc = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
    Set WsSrc = WbSrc.Sheets(1)
    With WsSrc
        Set LastCell = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False)
        .Range(.Range("A1"), LastCell).Copy
    End With
    With WsDest
        WriteRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row + 1
        '.Range("A" & WriteRow).Paste
        'OR
        .Range("A" & WriteRow).PasteSpecial
    End With
    '''To clear clipboard to avoid 'large clipboard' warnings on close
    Application.CutCopyMode = False

    WbSrc.Close
    Filename = Dir()
Loop

End Sub

I get the following error: Run-time error '438': Object doesn't support this property or methid Then the following line is highlighted: .Range("A" & WriteRow).Paste — Mannix, Jan 28 '18 at 16:49
@Mannix : Please create a new question. My best guess would be that you data set is exceeding the maximal size of the sheet. — R3uK, Feb 01 '18 at 08:26

Merge multiple .xls files into one sheet

1 Answers1