ดึงข้อมูลด้วยโค้ด vba ในแต่ละชีท ให้มาต่อๆ กันใน worksheet ใหม่เป็น ข้อมูลรวม

[March201711]

ต้องการดึงข้อมูลที่ worksheet "Data" ในแต่ละ sheet มารวมไว้ที่ worksheet "SumData" มาต่อกันที่ column B3 แต่ติดปัญหา sheet1 มีแค่บรรทัดเดียวค่ะ

Code: Select all

 Sub Update()
'
' Update Macro
'

'
    Windows("Data.xlsx").Activate
    Sheets("Sheet2").Select
    Range("B3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("H6").Select
    Windows("SumData.xlsm").Activate
    Range("B3").Select
    ActiveSheet.Paste
    Range("H5").Select
    Windows("Data.xlsx").Activate
    Range("H9").Select
    Windows("SumData.xlsm").Activate
    Range("I4").Select
    Windows("Data.xlsx").Activate
    Sheets("Sheet1").Select
    Range("B3:F3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("SumData.xlsm").Activate
    Range("H3").Select
End Sub
  

[snasui]

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

Code: Select all

Sub test0()
    Dim sb As Workbook, rs As Range
    Dim tb As Workbook
    Dim sh As Worksheet
    
    Set sb = Workbooks("Data.xlsx")
    Set tb = ThisWorkbook
    For Each sh In sb.Worksheets
        Set rs = sh.Range("b3", sh.Range("b" & sh.Rows.Count).End(xlUp))
        With tb.Worksheets("SumAllData")
            With .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
                .Resize(rs.Rows.Count, 5).Value = rs.Resize(, 5).Value
            End With
        End With
    Next sh
End Sub

[March201711]

ถามต่อนิดนึงค่ะ

ถ้าใน worksheet "Data2" มี sheet เดียว ชื่อ sheet list แต่ sheet นี้ข้อมูลจะมาทับเพิ่มหรือลดทุกวัน บางวันมีแค่บรรทัดเดียว บางวันมี 10-20 บรรทัด ถ้าต้องดึงข้อมูลจาก sheet มาต่อที่ worksheet "SumData" มาต่อกันทุกวันต้องปรับสูตรยังไงคะ
ลอง record marco แล้วแต่อยากให้ code vba มีความยึดหยุ่นค่ะ อยากให้กำหนดว่าถ้าบรรทัดต่อจากข้อมูลเป็นค่าว่าง ไม่ให้ดึงข้อมูลมาค่ะ ขอบคุณค่ะ

Code: Select all

 Sub run()
'
' run Macro
'

'
    Windows("Data2.xlsx").Activate
    Range("B3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Windows("SumData2.xlsm").Activate
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J6").Select
End Sub

[snasui]

มีชีตเดียวก็ใช้ Code เดิมได้ ไม่ทราบว่าได้ลองนำไปใช้แล้วหรือไม่ ถ้าลองใช้แล้วติดปัญหาตรงส่วนไหนครับ

[March201711]

ได้แล้วค่ะ ขอบคุณค่ะ

[March201711]

อยากให้ copy ข้อมูลโดยดูที่ Column C ว่าอยู่เดือนไหน ให้เอา copy ทั้งบรรทัดไปวางไว้ที่ เดือนนั้น
เช่น column C3 เป็นวันที่ 2-5-23 เป็นเดือน 5 (high light สีเหลือง) โดยดูที่ cell D1 ให้ copy เอาข้อมูลทั้งบรรทัดไปวางที่ sheet Sum_05 ค่ะ ใน workbook เดียวกัน

Code: Select all

Sub test2()
    Dim sb As Workbook, rs As Range
    Dim tb As Workbook
    Dim sh As Worksheet
    
    Set sb = Workbooks("Data2.xlsx")
    Set tb = ThisWorkbook
    For Each sh In sb.Worksheets
        Set rs = sh.Range("b3", sh.Range("b" & sh.Rows.Count).End(xlUp))
        With tb.Worksheets("Sum_" & Format(Range("D1"), "mmyy"))
            With .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
                .Resize(rs.Rows.Count, 5).Value = rs.Resize(, 5).Value
            End With
        End With
    Next sh
End Sub

[snasui]

ดูตัวอย่าง Code ที่โพสต์นี้ครับ viewtopic.php?t=19953

[March201711]

อาจารย์คะ ถ้า file งานที่ทำเป็นอีก file นึงไม่ได้ใช้งานบน marco เป็นไฟล์งานที่กดปุ่ม marco ส่วนตัวของเราเอง ต้องปรับไฟล์งานหลักยังไงคะ
และอยากปรับเป้น module ไม่ใช้ private sub น่ะค่ะอาจารย์

Code: Select all

Sub Updates()
    Dim sb As Workbook, rs As Range
    Dim tb As Workbook
    Dim sh As Worksheet
    
    Set sb = Workbooks("Data2.xlsx")
    Set tb = ThisWorkbook
    For Each sh In sb.Worksheets
        Set rs = sh.Range("b3", sh.Range("b" & sh.Rows.Count).End(xlUp))
        With tb.Worksheets("Sum_" & Format(Range("D1"), "mmyy"))
            With .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
                .Resize(rs.Rows.Count, 5).Value = rs.Resize(, 5).Value
            End With
        End With
    Next sh
End Sub

[snasui]

ยังไม่เข้าใจประเด็นที่ติดปัญหาครับ

การใช้ Event กับไม่ใช้ Event คือสร้างปุ่มกดเอง ต่างกันตรงที่เขียน Code ไว้คนละตำแหน่ง ถ้าต้องการใช้ Event ก็ไปวาง Code ไว้ในชีตนั้น ๆ ถ้าต้องการสร้างปุ่มกดก็เขียน Code ไว้ใน Module ปกติ ไม่ทราบว่าติดปัญหาตรงไหน อย่างไรครับ

[March201711]

ชอบใช้แบบกดปุ่มมากกว่าค่ะ เพราะบางครั้ง ไปคลิกที่เซลล์อื่นมันจะขึ้น pop up msgbox ให้เอง คือความจริงจะมีไฟล์ส่วนตัวของตัวเองที่รัน marco เฉพาะทุกไฟล์งาน ส่วนไฟล์งานจะไม่ save run marco เพราะบางครั้ง error โค้ดมาร์โคหายบ่อยๆ ค่ะ จึงต้องสร้างไฟล์งานของตัวเองต่างหากไม่อยากกระทบไฟล์งานจรืงค่ะ

ฉะนั้น ไฟล์หลักของตัวเองจะเป็นไฟล์มารโค เวลาเขียนโคดจึงต้องเปิดไฟล์งานที่ใช้ทุกครั้งค่ะ
จึงติดปัญหาที่ต้องอ้างอืง worksheetนี้ sheet เดือนทร่เลือกต้องเลือกจาก ไฟล์กลักของตัวเองค่ะ

ชื่อไฟล์ของตัวเองชื่อ workbook "Main_runsum.xlsm"

Code: Select all

  With tb.Worksheets("Sum_" & Format(Range("D1"), "mmyy")) 

[snasui]

ที่ระบุ Range("D1") ไว้นั้นปัจจุบันโปรแกรมไม่รู้จักว่าเป็นของไฟล์ไหนเพราะไม่ได้เขียน Code ระบุเอาไว้จนถึง Parent ของเซลล์นั้น ๆ

ตัวอย่างการปรับ Code ด้านล่าง เป็นการทำให้ไฟล์ที่จะใช้งาน Active ขึ้นมาก่อน การอ้างถึงเซลล์ใด ๆ จะหมายถึง Object ของไฟล์ที่กำลัง Active อยู่ขณะนั้นครับ

Code: Select all

'Other code
tb.Activate
With tb.Worksheets("Sum_" & Format(Range("D1"), "mmyy"))
    With .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
        .Resize(rs.Rows.Count, 5).Value = rs.Resize(, 5).Value
    End With
End With
'Other code

[March201711]

แก้ code ตามที่อาจารย์บอกแล้วค่ะ แต่ทำไม sheet sum_0523 ข้อมูลมาทุกบรรทัดเลยค่ะ อยากให้ดึงข้อมูลมาเฉพาะ เดือน 5 ที่เลือกที่ sheet "SumAllData" ที่ cell D1 ค่ะ ที่ถูกควรจะมาแค่ วันที่ 2/5/2023 ตามที่ high light สีเหลืองค่ะ

Code: Select all

Sub Updates()
    Dim sb As Workbook, rs As Range
    Dim tb As Workbook
    Dim sh As Worksheet
    
    Set sb = Workbooks("Data2.xlsx")
    Set tb = Workbooks("SumData_bymonth.xlsx")
    For Each sh In sb.Worksheets
        Set rs = sh.Range("b3", sh.Range("b" & sh.Rows.Count).End(xlUp))
    tb.Activate
        With tb.Worksheets("Sum_" & Format(Range("D1"), "mmyy"))
            With .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
                .Resize(rs.Rows.Count, 5).Value = rs.Resize(, 5).Value
            End With
        End With
    Next sh
End Sub

[snasui]

มาทุกบรรทัดเพราะไม่ได้เขียนเงื่อนไขให้ว่าให้มาเฉพาะตรงกับค่าใดถึงจะนำมาใช้ ลองศึกษาจากที่เคยเขียนไปให้ว่ามีการเขียนเงื่อนไขเข้าไปอย่างไรและลองปรับปรุงมาก่อน ติดแล้วค่อยถามกันต่อครับ