การรวม sheet แล้ว subtotal

[Garrod]

ผมได้ทำการรวมชีทตามนี้แล้ว http://snasui.blogspot.com/2009/12/sheet-sheet.html แล้วที่นี้ sheet ที่รวมเเล้วอยากจะทำ subtotal โดยจำแนกตาม เลข id แต่พอทำ subtotal แล้ว ข่้อมูลมาไม่ครบครับ รบกวนช่วยชี้แนะด้วยครับ

[snasui]

ถ้าจะ Subtotal หลังจากรวมแล้วให้ Copy แล้ววางเฉพาะค่าไปทำ Subtotal ครับ

[Garrod]

ขอบคุณสำหรับคำตอบครับ แต่อยากจะถามเพิ่มอีกนิดครับถ้าต้องการให้ มัน copy มาใน sheet ใหม่แบบ auto เลยได้ไหมครับเพราะ user คงไม่อยากลากแล้ว copy ครับ

[snasui]

การให้ Copy อัตโนมัติลองบันทึก Macro มาดูครับ ติดตรงไหนก็ถามกันได้เรื่อย ๆ

สำหรับการ Copy ข้อมูลที่ติดกันเป็นฐานข้อมูลไม่ต้องใช้การลากคลุม ลองตามนี้ครับ

1. คลิกลงในฐานข้อมูลแล้วกดแป้น Ctrl+A เพื่อคลุมข้อมูลทั้งหมด
2. กดแป้น Ctrl+C เพื่อ Copy
3. ไปยังเซลล์เป้าหมายแล้วคลิกขวา > Paste Special > Values > OK

[Garrod]

ผมลองเขียนดูแล้วเเต่มันไม่มาครับ Macro ที่ผมเขียนนี่ถูกไหมครับ

Sub total()
x = 2
Do While Cells(x, 1) <> ""

Worksheets("Total").Rows(x).Copy
Worksheets("Sheet4").Activate
erow = Sheet4.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet4").Rows(erow)

Worksheets("Total").Activate
x = x + 1
Loop

' total Macro
'
' Keyboard Shortcut: Ctrl+t
'

Sheets("Sheet4").Select
End Sub

[snasui]

เพิ่ม Sheet3 เข้ามาแล้วลองทดสอบ Code ตามด้านล่างครับ

Code: Select all

Sub Test()
    Dim rSource As Range
    Dim rTarget As Range
    Set rSource = Sheets("รวม").Range("A1:C" & Sheets("รวม") _
        .Range("H3") + 1)
    Set rTarget = Sheets("Sheet3").Range("A1")
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

[วังวู ช่ง]

เพิ่ม Sheet3 เข้ามาแล้วลองทดสอบ Code ตามด้านล่างครับ

Code: Select all

Sub Test()
    Dim rSource As Range
    Dim rTarget As Range
    Set rSource = Sheets("รวม").Range("A1:C" & Sheets("รวม") _
        .Range("H3") + 1)
    Set rTarget = Sheets("Sheet3").Range("A1")
    rSource.Copy
    rTarget.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub