VBA Copy ข้อมูลมีค่ามากกว่า 0

[suka]

เรียนอาจารย์ และท่านผู้รู้ช่วยปรับโค้ดค่ะ

จากตัวอย่างไฟล์แนบที่ชีท Template ต้องการให้โค้ด Copy ข้อมูลเฉพาะค่าในคอลัมน์ D มีค่ามากกว่า 0 นำข้อมูลไปวางที่ชีท Data

ตัวอย่างที่ต้องการตามชีท Data ที่ระบายสีเหลืองค่ะ

Code: Select all

Sub UpWages()
        Dim rSource As Range
        Dim rTarget As Range
        With Worksheets("Template")
            Set rSource = .Range("A2:E2").Resize(.Range("G1"))
        End With
        Set rTarget = Worksheets("Data").Range("A65536").End(xlUp).Offset(1, 0)
            rSource.Copy
            rTarget.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
End Sub

[snasui]

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

Code: Select all

Sub UpWages()
    Dim rSource As Range
    Dim r As Range, rTarget As Range
    Worksheets("Data").Range("a1").CurrentRegion.Offset(1, 0).ClearContents
    With Worksheets("Template")
        Set rSource = .Range("D2", .Range("D" & .Rows.Count).End(xlUp))
        For Each r In rSource
            If r.Value > 0 Then
               Worksheets("Data").Range("a" & .Rows.Count) _
                .End(xlUp).Offset(1, 0).Resize(1, 5).Value = _
                r.Offset(0, -3).Resize(1, 5).Value
            End If
        Next r
    End With
End Sub

[suka]

ขอบคุณอาจารย์มาก ๆ ค่ะ ได้ตรงตามที่ต้องการเลยค่ะ