Excel Forum

Code: Select all

Sub TestCode2()
              
    'Start to merge file
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
     
    'Range("A1") is file path, it can be changed  or filled path like  "C:\Users\Administrator\Desktop\test"
    'Range("A1:O) ==> O is the last column that contain data.If  your data is over than column O, you can change it
    'Offset(1, -14) is down 1 and left 14 -- change it too. (Å§ä» 1 ªèͧ ä»·Ò§«éÒ 14 ªèͧ ¶éÒ¢éÍÁÙÅÁÒ¡¡ÇèÒ O ¡çµéͧ¹ÑºA-O áÅéÇź1 á¡éàÅ¢àÍÒ)
    'ThisWorkbook.Worksheets(2).Activate à»ç¹ÅӴѺ¢Í§ªÕ·¨Ò¡«éÒ ¶éÒªÕ··ÕèÃÇÁÍÂÙèã¹ÅӴѺ·Õèà·èÒäËÃè¡çµéͧà»ÅÕè¹àÅ¢ÅӴѺ´éÇÂ
    
   Set dirObj = mergeObj.Getfolder(Sheets("Sheet1").Range("A1"))
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)
        bookList.Sheets(1).Range("A1:O" & bookList.Sheets(1).Range("O65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate
        If Range("O65536").End(xlUp).Offset(1, -14).Row = 1 Then
            Range("a1").PasteSpecial
        Else
            Range("O65536").End(xlUp).Offset(1, -14).PasteSpecial
        End If
        Application.CutCopyMode = False
        bookList.Close False
    Next
    Application.ScreenUpdating = True

End Sub

Code: Select all

'--Other code
For Each everyObj In filesObj
    Set bookList = Workbooks.Open(everyObj)
    'bookList.Sheets(1).Range("A1:O" & bookList.Sheets(1).Range("O65536").End(xlUp).Row).Copy
    bookList.Sheets(1).UsedRange.Copy
    ThisWorkbook.Worksheets(1).Activate
    If Range("O65536").End(xlUp).Offset(1, -14).Row = 1 Then
        Range("a1").PasteSpecial
    Else
        Range("O65536").End(xlUp).Offset(1, -14).PasteSpecial
    End If
    Application.CutCopyMode = False
    bookList.Close False
Next
'--Other code

Code: Select all

'--Other code
If Range("B65536").End(xlUp).Offset(1, -1).Row = 1 Then
    Range("a1").PasteSpecial
Else
    Range("B65536").End(xlUp).Offset(1, -1).PasteSpecial
End If
'--Other code