การคัดลอกข้อมูลแบบมีเงื่อนไข

[Sirinat_d]

ถ้าคอลัมน์F มีคำว่า"ReOrder" ให้คัดลอกข้อมูลคอลัมน์AและC ไปวางในหน้าใบสั่งซื้อ

[snasui]

ได้เขียน Code มาเองแล้วยัง ติดปัญหาตรง Module ไหน Code ชื่อว่าอะไร อ่านกฎข้อ 5 ด้านบนแล้วอธิบายมาใหม่อีกรอบครับ

[Sirinat_d]

'อันนี้เป็น code คำสั่งที่จะคัดลอกข้อมมูล Cells(i, 1), Cells(i, 3) ของแถวที่ Cells(i, 6).Value = "ReOrder" ไปไว้ในworksheet("Purchase")ค่ะ แต่พอกดรัน แล้วรันไม่ออกค่ะ ไม่ทราบว่าใช้คำสั่งเหมาะสมกับความต้องการหรือไม่ค่ะ หรือว่ามีข้อผิดพลาดตรงไหน แนะนำด้วยค่ะ


Sub copy()
Dim i As Long
Dim lastRow As Long
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Sheets("Order").Cells(i, 6).Value = "ReOrder" Then
Range((Cells(i, 1)), (Cells(i, 3))).Select
Selection.copy
Sheets("Purchase").Select
Cells("A6").Select
Selection.Paste

Else
Sheets("Order").Cells(i, 6).Value = ""

End If
Next i
End Sub

[logic]

ไฟล์แนบไม่เห็นมีชีต order ชีต purchase และไม่มี code ตามโพสต์ด้านบน แนบมาใหม่อีกทีครับ

[Sirinat_d]

ไฟล์แนบไม่เห็นมีชีต order ชีต purchase และไม่มี code ตามโพสต์ด้านบน แนบมาใหม่อีกทีครับ

[snasui]

อ่านวิธีโพสต์ Code ให้เป็น Code ที่กฎการใช้บอร์ดข้อ 5 ด้านบนเพื่อสะดวกต่อการอ่านและ Copy ไปทดสอบครับ

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

Code: Select all

Sub copy()
    Dim i As Long
    Dim lastRow As Long
    Dim r As Range
    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        If Sheets("Order").Cells(i, 6).Value = "ReOrder" Then
            Set r = Union(Cells(i, 1), Cells(i, 3))
            r.copy
            Sheets("Purchase").Select
            Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets("Order").Select
        End If
    Next i
    Application.CutCopyMode = False
End Sub

[Sirinat_d]

ขอโทษด้วยค่ะ แล้วจะนำไปปรับปรุงนะคะ
ในส่วนของcode ยัง run ไม่ได้เลยค่ะ

Code: Select all

 Sub Order()
Dim i As Long
Dim lastRow As Long
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Cells(i, 4).Value <= Cells(i, 5).Value Then
Cells(i, 6).Value = "ReOrder"
Else
Cells(i, 6).Value = ""

End If
Next i
End Sub
Sub copy()
    Dim i As Long
    Dim lastRow As Long
    Dim r As Range
    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        If Sheets("Order").Cells(i, 6).Value = "ReOrder" Then
            Set r = Union(Cells(i, 1), Cells(i, 3))
            r.copy
            Sheets("Purchase").Select
            Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets("Order").Select
        End If
    Next i
    Application.CutCopyMode = False
End Sub

[snasui]

Code ที่ถามคือการ Copy ไม่ทราบว่า Run ได้แล้วยังครับ

หากไม่ได้ติดตรงไหน แก้ไปทีละเรื่อง สำหรับการเขียนชื่อ Code ไม่ควรเขียนว่า "Copy" หรือ "Paste" เพราะจะไปซ้ำกับคำสั่งของโปรแกรม อาจจะก่อให้เกิดปัญหาได้ครับ