ต้องการรวมหลายๆไฟล์ เป็นไฟล์เดียว แต่ Code ดึงข้อมูลไม่ครบ

[pori]

สวัสดีค่ะ

อยากสอบถามเรื่องจะให้รวมหลายๆไฟล์เป็นไฟล์เดียวกัน โดยที่แต่ละไฟล์มีรูปแบบข้อมูลเหมือนกันทุกอย่าง แต่มีปริมาณข้อมูลไม่เท่ากัน

โดยใช้ Code ของเก่าที่เคยใช้อีกงานตามข้างล่างนี้ค่ะ แต่เจอปัญหา Code ดึงข้อมูลมาไม่ครบ เนื่องจาก บรรทัดสุดท้าย คอลัมน์สุดท้ายมันไม่มีข้อมูล Code เลยไม่ดึงมาให้ (ตามที่อยู่ใน sheet1) ซึ่งสิ่งที่ต้องการอยู่ในชีท "ผลลัพธ์ที่ต้องการ" ค่ะ รบกวนสอบถามว่าควรจะต้องแก้ Code เพิ่มเติมตรงไหน ถึงจะดึงข้อมูลได้ครบค่ะ

ขอบคุณมากๆที่ให้ช่วยคำแนะนำ

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

แนบไฟล์ตัวอย่างตามนี้ค่ะ

ข้อมูลดิบที่ต้องการรวมกันเป็นไฟล์เดียว

[snasui]

ตัวอย่างการปรับ Code ครับ

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

[pori]

ขอบคุณอาจารย์มากๆค่ะ ลองเอาไปใช้แล้ว แต่เหมือนว่าข้อมูลยังมาไม่ครบเลยค่ะ เพราะว่าบรรทัด *รวม ของแต่ละ sheet ไม่ยอมมาด้วยเลย อยากให้ดึงข้อมูลแต่ละไฟล์มาจนสุดบรรทัดนี้เลยค่ะ

แนบไฟล์ใหม่ค่ะ ได้แบบนี้

[snasui]

ตัวอย่างการปรับ Code หากมีปัญหาอื่นใดให้ปรับ 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

[pori]

ขอบพระคุณอาจารย์มากๆค่ะ พอดีก่อนหน้านี้ลองแก้เอง โดยไปเปลี่ยนจากคอลัมน์ O เป็น M ทั้งหมด แต่ข้อมูลมันไม่เห็นมาเลยค่ะ ก็เลยงงๆไป คงทำผิด พออาจารย์แก้ให้เป็น B ทีนี้มาครบเลยค่ะ ขอบคุณมากเลยค่ะ