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
Do NOT use UsedRange, it is highly unreliable, see here you to find the last cell : stackoverflow.com/a/11169920/4628637 — R3uK
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 — Anubhav Dikshit
I wouldn't use UsedRange either, but I was just trying to point in the right direction. — Vulthil
I would suggest the Range.CurrentRegion property as an alternative to the Worksheet.UsedRange property but it depends upon the data containing any full blank rows or columns halting the expansion of the current region from A1. — user4039065

R3uK R3uK · Accepted Answer · 2015-12-07T07:58:26

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

Merge multiple .xls files into one sheet

1 Answers