Combine/merge 51 Workbooks In Same Folder

'originally from http://www.ozgrid.com/forum/showthread.php?t=28270&highlight=merge+workbooks


Option Explicit
 
Dim rngData As Range
 
Sub ReadWorkbooks()
     
     ' Change the directory to your source directory
    Const strDirectory As String = "C:\test\"
    Dim varFile As Variant
     
    Set rngData = ThisWorkbook.Worksheets("Sheet1").Range("A" & _
    ThisWorkbook.Worksheets("Sheet1").Range("A65536").End(xlUp).Row).Offset(1, 0)
     
    Application.ScreenUpdating = False
    With Application.FileSearch
        .NewSearch
        .LookIn = strDirectory
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute > 0 Then
            For Each varFile In .FoundFiles
                Merge varFile
            Next
        End If
    End With
    Application.ScreenUpdating = True
     
End Sub
 
Sub Merge(ByVal strFileName As String)
     
    Dim lngEndRow As Long, lngRow As Long
    Dim ws As Worksheet, shp As Shape
     
     ' Open the current  workbook
    Workbooks.Open strFileName
     
     ' Process each sheet in the current workbook
    For Each ws In ActiveWorkbook.Worksheets
        lngEndRow = ws.Range("A65536").End(xlUp).Row
        
        'Copy the visible rows to the main worksheet
        ws.Range("A1:AE" & lngEndRow).Copy rngData
         
        'move last row of main sheet on again.
        Set rngData = ThisWorkbook.Worksheets("Sheet1").Range("A" & _
        ThisWorkbook.Worksheets("Sheet1").Range("A65536").End(xlUp).Row).Offset(1, 0)
    Next ws
     
     ' Close the current workbook without saving any of the changes made
    ActiveWorkbook.Close SaveChanges:=False
     
End Sub