Snasui Excel Forum

:D [color=#FF8000]Code ด้านบนไม่ได้กรอกชื่อชีต[/color] โปรแกรมจะ Loop เอาค่าทุกชีตมาวางในชีตที่ใช้รวมข้อมูลครับ

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

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

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



[quote="snasui"]:D ลองปรับ Code เป็นตามด้านล่างครับ
[code]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
[/code][/quote]

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

:D ลองปรับ Code เป็นตามด้านล่างครับ
[code]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
[/code]

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

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

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