Sub OpenFile()
    Dim sPath As String
    Dim sFil As String
    Dim strName As String
    Dim twbk As Workbook
    Dim owbk As Workbook
    Dim ws As Worksheet

    Set twbk = ActiveWorkbook
    sPath = "C:Data Folder" 'Change to suit
    sFil = Dir(sPath & "*.xls")

    Do While sFil <> ""
        strName = sPath & sFil
        Set owbk = Workbooks.Open(strName)
        Set ws = owbk.Sheets(1)
        ws.Range("A1", Range("A" & Row.Count).End(xlUp)).Copy
        twbk.Sheets(1).Range("A65536").End(xlUp)(2).PasteSpecial xlPasteValues
        owbk.Close False 'Close no save
        sFil = Dir
    Loop

twbk.Save
End Sub