สอบถาม code vba การรวมข้อมูลจากหลายชีท

[Somkamol]

ต้องขอรบกวนสอบถามค่ะ เรื่องการเขียน Code VB ใน excel ตาม File แนบมีคำถามดังนี้ค่ะ
Sheet "CollecData" ต้องการ Copy ข้อมูลจาก 2 sheet มาต่อกันและทำการรวมยอดแต่ละช่วง จากนั้นทำยอด GrandTotal ด้านล่างค่ะ
ดิฉันพยายามเขียน Code เท่าที่ทำได้ก็ไม่สำเร็จค่ะ และที่สำคัญข้อมูลที่ 2 sheet จะมีจำนวนไม่คงที่ในแต่ละวันค่ะ
ดิฉันจึงขอรบกวนช่วยแนะนำด้วยค่ะ

[bank9597]

รบกวนเปลี่ยนชื่อกระทู้ให้สื่อถึงปัญหาด้วยครับ

ส่วน VBA เดี๋ยวรอท่านอื่นมาแนะนำอีกครั้งครับ

[snasui]

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

Code: Select all

Sub CollecDataCPT()
    Dim wh As Worksheet, rSource As Range
    Dim grandTotal As Double, subTotal As Double
    Dim rTarget As Range
    For Each wh In Worksheets
        If wh.Name <> "CollecData" Then
            With wh
                Set rSource = .Range("a9", .Range("a" & Rows.Count).End(xlUp)) _
                    .Resize(, 100)
                subTotal = Application.Sum(rSource.Offset(0, 10))
                grandTotal = grandTotal + subTotal
            End With
            With Sheets("CollecData")
                Set rTarget = .Range("b" & Rows.Count).End(xlUp)
                If rTarget.Row = 5 Then
                    Set rTarget = rTarget.Offset(1, -1)
                Else
                    Set rTarget = rTarget.Offset(3, -1)
                End If
            End With
            rSource.Copy
            rTarget.PasteSpecial xlPasteValues
            rTarget.PasteSpecial xlPasteFormats
            With Sheets("CollecData").Range("a" & Rows.Count).End(xlUp)
                .Offset(1, 0) = wh.Name & " Total"
                .Offset(1, 10) = subTotal
            End With
        End If
    Next wh
    With Sheets("CollecData").Range("a" & Rows.Count).End(xlUp)
        .Offset(1, 0) = "Grand Total"
        .Offset(1, 10) = grandTotal
    End With
End Sub

[Somkamol]

ต้องขอขอบคุณจริงๆค่ะ ช่วยได้มากเลย

ขอบคุณมากค่ะ

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

Code: Select all

Sub CollecDataCPT()
    Dim wh As Worksheet, rSource As Range
    Dim grandTotal As Double, subTotal As Double
    Dim rTarget As Range
    For Each wh In Worksheets
        If wh.Name <> "CollecData" Then
            With wh
                Set rSource = .Range("a9", .Range("a" & Rows.Count).End(xlUp)) _
                    .Resize(, 100)
                subTotal = Application.Sum(rSource.Offset(0, 10))
                grandTotal = grandTotal + subTotal
            End With
            With Sheets("CollecData")
                Set rTarget = .Range("b" & Rows.Count).End(xlUp)
                If rTarget.Row = 5 Then
                    Set rTarget = rTarget.Offset(1, -1)
                Else
                    Set rTarget = rTarget.Offset(3, -1)
                End If
            End With
            rSource.Copy
            rTarget.PasteSpecial xlPasteValues
            rTarget.PasteSpecial xlPasteFormats
            With Sheets("CollecData").Range("a" & Rows.Count).End(xlUp)
                .Offset(1, 0) = wh.Name & " Total"
                .Offset(1, 10) = subTotal
            End With
        End If
    Next wh
    With Sheets("CollecData").Range("a" & Rows.Count).End(xlUp)
        .Offset(1, 0) = "Grand Total"
        .Offset(1, 10) = grandTotal
    End With
End Sub

[pairuch23]

ในกรณีที่มี sheet จำนวนมาก และ ไม่สะดวกในการ กรอก sheet name ใน code
มีวิธ๊ไหนบ้างคัรบ

[snasui]

Code ด้านบนไม่ได้กรอกชื่อชีต โปรแกรมจะ Loop เอาค่าทุกชีตมาวางในชีตที่ใช้รวมข้อมูลครับ