Code copy data for Report

[yukioh]

เรียนอาจารย์ และ ท่านผู้รู้ทุกท่าน

ขออนุญาตรบกวนสอบถาม VBA ดึง ข้อมูร จาก sheet "entry" มาใส่ sheet "report"
แต่ว่า code ที่ได้มา จะ copy แต่ข้อมุูนเพียง 2 ตัวครับ ดังไฟล์ที่แนบมา


จึงรบกวนอาจารย์ ณ ที่นี้ ขอขอบพระคุณล่วงหน้ามากครับ

[snasui]

ตัวอย่าง Code ตามด้านล่าง ลองปรับใช้ดูครับ

Code: Select all

Sub Test00()
    Dim rSource As Range
    Dim rTarget As Range
    With Sheets("Entry")
        Set rSource = .Range("a10", .Range("a163").End(xlUp))
    End With
    With Sheets("Report")
        Set rTarget = .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
    End With
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    rSource.Offset(0, 5).Copy
    rTarget.Offset(0, 1).PasteSpecial xlPasteValues
    rSource.Offset(0, 2).Copy
    rTarget.Offset(0, 2).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

[yukioh]

ผมลองแล้วครับ ใช้ได้

ถ้าสมมุติว่า หากเรา enter ข้อมูนที่มากกว่า 163 items จะทำยังไงให้ ครับให้ flexible?

[snasui]

ลองปรับมาเองก่อน ติดแล้วค่อยถามกันต่อครับ

[yukioh]

ผมใส่อย่างนี้ครับ แต่ data ไม่มา ครับ

Code: Select all

 Dim rSource As Range
    Dim rTarget As Range
    Dim LRs As Long 'last row
    Dim FR As Long 'first row
    With Sheets("Entry")
        'Set rSource = .Range("a10", .Range("a163").End(xlUp))
        LRs = .Cells.Find("Total", , , , xlByRows, xlPrevious).Row - 1
        FR = .Cells.Find(shTOM, , , , xlByRows, xlPrevious).Row + 1
        Set rSource = .Cells(LRs, FR).Offset(0)

        
    End With
    With Sheets("Report")
        Set rTarget = .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0)
    End With
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    rSource.Offset(0, 5).Copy
    rTarget.Offset(0, 1).PasteSpecial xlPasteValues
    rSource.Offset(0, 2).Copy
    rTarget.Offset(0, 2).PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False

[snasui]

ลองปรับ Code Set rSource = .Range("a10", .Range("a163").End(xlUp)) เป็น Set rSource = .Range("a10", .Range("a10").End(xlDown)) ครับ

[yukioh]

ขอขอบพระคุณมากครับ