รวม sheet จากไฟล์อื่นๆมาไว้ในไฟล์เดียวกัน VBA

[humnoy12]

อยากจะรวม sheet จากไฟล์อื่นๆมาไว้ในไฟล์เดียวกันครับ ซึ่งบางไฟล์มีหลาย sheet ด้วยกันจะเพิ่มเติม code ยังไงดีครับช่วยแนะนำหน่อยครับ
พึ่งเริ่มต้นเขียน vba ครับ

Code: Select all

Sub Copy()
    Dim wb As Workbook
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Set wb = Workbooks.Open(Application.GetOpenFilename)
    wb.Worksheets(1).Cells.Copy
    ws.Range("A1").PasteSpecial
    wb.Close
End Sub

[snasui]

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

Code: Select all

Sub Copy()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wk As Worksheet
    Set ws = ActiveSheet
    Set wb = Workbooks.Open(Application.GetOpenFilename)
    For Each wk In wb.Worksheets
        wk.UsedRange.Copy ws.Range("a" & ws.Rows.Count).End(xlUp).Offset(1, 0)
    Next wk
    wb.Close
End Sub

[humnoy12]

ขอบคุณครับอาจารย์ ตรงกับความต้องการครับ แต่อยากจะเพิ่มเติมว่าให้แยกเป็น sheet ของใครของมันไม่ต้องมารวมไว้ที่ sheet เดียวครับ
อย่างเช่นในภาพ

[snasui]

ลองปรับ Code มาเองก่อน ติดตรงไหนค่อยถามกันต่อ ในการสอบถามปัญหาควรแนบไฟล์ประกอบจะได้สะดวกในการตอบครับ

[humnoy12]

ลองปรับ code ดูแล้วตอนนี้มาแค่ Sheet เดียวครับ ควรจะเพิ่มเติมตรงไหนดีครับ อยากจะให้ Sheet ในไฟล์ทั้งหมดมาอยู่ในอีก ไฟล์นึงครับ

Code: Select all

Sub OpenFileCopy()
Dim wb1 As Workbook
Dim wb2 As Workbook

Set wb1 = ActiveWorkbook

FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xlsx (*.xlsx),")

If FileToOpen = False Then
    Exit Sub
Else
    Set wb2 = Workbooks.Open(Filename:=FileToOpen)

    For Each Sheet In wb2.Sheets
        If Sheet.Visible = True Then
            Sheet.Copy After:=wb1.Sheets(wb1.Sheets.Count)
            wb2.Close
        End If
    Next Sheet

End If

End Sub

[humnoy12]

ตอนนี้ลองปรับแก้แล้ว ได้ตามที่ต้องการแล้วครับ

Code: Select all

Sub OpenFileCopy()
Dim wb1 As Workbook
Dim wb2 As Workbook


Set wb1 = ActiveWorkbook

FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xlsx (*.xlsx),")

If FileToOpen = False Then
    Exit Sub
Else
    Set wb2 = Workbooks.Open(Filename:=FileToOpen)

    For Each Sheet In wb2.Sheets
        If Sheet.Visible = True Then
            Sheet.Copy after:=wb1.Sheets(wb1.Sheets.Count)
            
        End If
    Next Sheet
    wb2.Close
End If

End Sub