สอบถามดึงค่าสรปจากหลายไฟล์ หลายชีท มาสรุปในชีทเดียว

[sensitive_ucs]

เดิมทีการดึงข้อมูล จะเป็น 1สาขา 1ห้าง 1ไฟล์ แล้วผมจำทำการรวมไฟล์ทั้งหมดในโฟลเดอร์เดียวก่อน
แล้วเช็คชื่อไฟล์ก่อนว่าจำนวนครบไหม แล้วจะทำการดึงข้อมูล

แต่ตอนนี้ไฟล์ที่ทำมีการเปลี่ยนแปลง เป็น 1ห้าง หลายสาขา 1ไฟล์ เวลาดึงข้อมูลก็จะดึงมา จะมาแต่เฉพาะชีทแรกในไฟล์นั้น

ผมจะอยากขอคำแนะนำว่าจาก code ผมเดิมต้องเปลี่ยนแปลงส่วนใดเพิ่มเติมบ้าง การจะวนลูปให้ครบทุก sheet จะต้องมีเทคนิดอย่างไรบ้างครับ

ผมใช้วิธี
'For i = 1 To WS_count
CopyPaste
'Next i
'ActiveWorkbook.Close

ปรากฏว่าโปรแกรมเปิดไฟล์ แต่ไม่ก็อปปี้ข้อมูลให้ครับ

[snasui]

ตอนนี้ยังไม่สะดวกในการตรวจสอบ Code ครับ สำหรับการรวมข้อมูลจากหลายไฟล์ หลายชีท ดูได้จากที่่นี่ครับ viewtopic.php?f=9&t=3228

ช่วยแจ้งเฉพาะ Procedure ที่เกียวข้องและโพสต์ลงในกล่องความเห็นนี้ด้วย สำหรับการโพสต์ Code ให้แสดงเป็น Code ดูที่นี่ครับ viewtopic.php?f=3&t=1187

[sensitive_ucs]

Procedure GetData() ครับ

โดยการดึงข้อมูลมาจะเรียกใช้ CopyPaste() ครับ

Code: Select all

Sub GetData()
    
    Dim WS_count As Integer
    Dim i As Integer
    WS_count = Worksheets.Count
    
    
    Application.DisplayAlerts = False
    On Error Resume Next
    Dim Directory As String, f As String
    Application.ScreenUpdating = False
    
    Application.Goto Reference:="Area_TempDB"
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Directory = ThisWorkbook.Path & "\"
    f = Dir(Directory)
    If f <> ThisWorkbook.Name Then
        Workbooks.Open Filename:=ThisWorkbook.Path & "\" & f
                CopyPaste
    End If
    Do While f <> ""
        f = Dir
        If f <> "" And f <> ThisWorkbook.Name Then
            Workbooks.Open Filename:=ThisWorkbook.Path & "\" & f
            'For i = 1 To WS_count
                CopyPaste
            'Next i
            'ActiveWorkbook.Close
        End If
    Loop
    Application.ScreenUpdating = True
End Sub

Sub CopyPaste()

    'Sheets(i).Activate
    Application.Goto Reference:="R1C1:R1000C9"
    Selection.Copy
    ActiveWorkbook.Close
    Application.Goto Reference:="Target"
    ActiveSheet.Paste
End Sub

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub GetData()
    Dim WS_count As Integer
    Dim i As Integer
    Dim wb As Workbook
    Dim Target As Range
    Dim wbo As Workbook
    
    Set wbo = ThisWorkbook
    Application.DisplayAlerts = False
    On Error Resume Next
    Dim Directory As String, f As String
    Application.ScreenUpdating = False
    
    Application.Goto Reference:="Area_TempDB"
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Directory = ThisWorkbook.Path & "\"
    f = Dir(Directory)
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Workbooks.Open Filename:=ThisWorkbook.Path & "\" & f
            Set wb = ActiveWorkbook
            WS_count = wb.Worksheets.Count
            For i = 1 To WS_count
                Set Target = wbo.Sheets("DB").Range("A" & Rows.Count) _
                    .End(xlUp).Offset(1, 0)
                wb.Worksheets(i).Range("A2:I1000").Copy Target
            Next i
            wb.Close
        End If
        f = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

[sensitive_ucs]

อาจารย์ครับ รบกวนปรึกษาเพิ่มเติมครับ
จากโค้ดที่อาจารย์แนะนำผมทำได้ตามต้องการแล้วครับ ขอบคุณมากครับ
แต่อยากทราบเพิ่มเติมว่า จากโค้ดของอาจารย์ โค้ดไหนคือการ Paste ข้อมูลครับเพราะเห้นมีแต่ Copy Target ครับ

[bank9597]

อาจารย์ครับ รบกวนปรึกษาเพิ่มเติมครับ
จากโค้ดที่อาจารย์แนะนำผมทำได้ตามต้องการแล้วครับ ขอบคุณมากครับ
แต่อยากทราบเพิ่มเติมว่า จากโค้ดของอาจารย์ โค้ดไหนคือการ Paste ข้อมูลครับเพราะเห้นมีแต่ Copy Target ครับ

ถ้าไม่ผิดก็น่าจะเป็นตัวนี้ครับ

Next i

เพราะได้เซ็ตไว้แล้วว่า
WS_count = wb.Worksheets.Count
For i = 1 To WS_count

[snasui]

จากโค้ดของอาจารย์ โค้ดไหนคือการ Paste ข้อมูลครับเพราะเห้นมีแต่ Copy Target ครับ

Code ด้านล่างเป็นการ Copy แล้ววางไปยัง Target ครับ สำหรับการ Copy มี Option ให้เลือกวางได้เลย โดยการวรรคไป 1 ครั้งแล้วคีย์เป้าหมายที่จะวางไว้หลังคำว่า Copy

wb.Worksheets(i).Range("A2:I1000").Copy Target

[sensitive_ucs]

จากโค้ดของอาจารย์ โค้ดไหนคือการ Paste ข้อมูลครับเพราะเห้นมีแต่ Copy Target ครับ

Code ด้านล่างเป็นการ Copy แล้ววางไปยัง Target ครับ สำหรับการ Copy มี Option ให้เลือกวางได้เลย โดยการวรรคไป 1 ครั้งแล้วคีย์เป้าหมายที่จะวางไว้หลังคำว่า Copy

wb.Worksheets(i).Range("A2:I1000").Copy Target

ขอบคุณมากครับ กระจ่ายเลยครับ ไม่เคยทราบมาก่อนเลยนะครับว่า Option ของ Copy สามารถใช้งานแบบนี้ได้