การรวมไฟล์ข้อมูล excel หลายๆไฟล์เป็น ไฟล์เดียว

[tstc79tt]

หากผมมี ไฟล์ excel สมมุติว่า ชื่อ ขึนต้นแบบเดียวกันหมด เช่น xyz.data1.today.csv (csv เปิดใน excel ได้เหมือนไฟล์ excel ปกติ) และต่อมาเป็น xyz.data2.today.csv และต่อๆไปเรื่อย โดยที่ขึ้นต้น ด้วย xyz เหมือนกัน อยู่ในโฟลเดอเดียวกัน

โดยแต่ละ ไฟล์ นั้น ข้อมูลอยู่แค่ ใน cell A1 หากผมต้องการนำข้อมูลในไฟล์ทั้งหมดมาเรียงต่อกันลงไปเรื่อยๆ ใน excel ไฟล์ใหม่

มีวิธีแนะนำอย่างไรบ้างครับ

[snasui]

ลองดูตัวอย่างจากที่นี่ครับ http://snasui.blogspot.com/2010/06/blog-post.html

[tstc79tt]

ขอบคุณครับ เดี๋ยวผมจะมาปรึกษาใหม่ครับ

[tstc79tt]

มีคำถามน่ะครับ

หากต้องการให้มัน search ในโฟลเดอใดโฟลเดอนึง หาชื่อไฟล์ที่มาเป็นเซ็ตแบบด้านบน และดึงคำตอบมาใส่ๆรวมกันไว้ในไฟล์เดียว ด้วย VBA นี่ มีคำแนะนำอะไรผมไหมครับ ว่าควรเริ่มจากไหน code ประมาณไหนก่อน

[snasui]

คร่าว ๆ นะครับ เริ่มจาก Code Loop หาไฟล์ใน Folder ก่อนครับ เมื่อเจอแล้วค่อยดึงค่าในไฟล์นั้น ๆ มาวางตามต้องการ ส่วนจะเขียนอย่างไรผมไม่เขียนเป็นตัวอย่างครับ เขียนมาก่อนแล้วถามกันเฉพาะที่ติดปัญหา หากยังเขียนไม่ได้ก็ยังไม่ควรใช้ VBA ลักษณะนี้ ให้ศึกษามาก่อนเป็นลำดับ สำหรับฟอรัมนี้ ในส่วนที่เป็น VBA นั้น จะเน้นการแก้ปัญหาเป็นหลักครับ

[tstc79tt]

โอเคครับ

[Jeab01]

รบกวนค่ะ นำโค้ดมาลองรวมไฟล์ดูแล้ว ติดerror ค่ะ
ต้องแก้ตรงไหนได้บ้างค่ะ
ขอบคุณค่ะ
ต้องรวมทั้งหมด 230 ไฟล์ เริ่มตั้งแต่ แถวที่13 ที่ต้องการดึง

[snasui]

ช่วยแจ้ง Error มาด้วยว่าติดขัดที่ Module ไหน อย่างไร จะได้เข้าถึงปัญหาได้โดยไวครับ

[Jeab01]

แนบไฟล์หน้าจอที่ errorค่ะ

[puriwutpokin]

ปรับเป็น

Code: Select all

Sub CollectDataFromMultipleFiles()
   Dim wb As Workbook, s As Worksheet, db As Worksheet
    Dim strPath As Variant, i As Integer, f As Byte
    strPath = Application.GetOpenFilename( _
        FileFilter:="Excel File (*.xls*),*.xls*", _
        MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
    Set db = ThisWorkbook.Sheets(1)
    db.UsedRange.ClearContents
    Application.ScreenUpdating = False
For i = 1 To UBound(strPath)
Set wb = Workbooks.Open(strPath(i))
For Each s In wb.Worksheets
        f = IIf(db.Range("a1").Value = "", 0, i)
        If s.Range("a1").Value <> "" Then
         s.UsedRange.Offset(f, 0).Copy
           With db
                    .Range("a" & .Rows.Count).End(xlUp).Offset(f, 0) _
                        .PasteSpecial xlPasteValues
                End With
End If
        Next s
        wb.Close
        Application.CutCopyMode = False
    Next i
    Application.ScreenUpdating = True
    MsgBox "Finished", vbInformation
End Sub