คำสั่ง Loop เพื่อส่งข้อมูลบันทึก

[Bafnet]

สวัสดีครับอาจารย์ มีเรื่องรบกวนอีกแล้วครับ
พยายามแก้ไขแล้วครับตั้งแต่ 9 โมงจนป่านนี้ เลยถอดใจแล้วครับ
คือผมมีรายการที่ต้องการส่งไปบันทึกเก็บไว้ โดยมีเงื่อนไขคือ
1.ต้องเป็นรายการข้อมูลเฉพาะตรงกับหน่วยอำเภอที่เลือก
2.ต้องมีค่าเป็น In Active (เป็นข้อมูลที่ไม่เคยบันทึก)
โดยผมเลือกใช้คำสั่ง Do until คำสั่งตามนี้ครับ

Code: Select all

Private Sub CommandButton4_Click()
Dim ry As Range
Dim rs As Range
Dim rx As Range
Dim rt As Range
Dim ri As Range
Dim Mydata As Range
Dim Key As Object
Dim r As Long
Dim cri As String
Dim crx As String
Application.ScreenUpdating = False
If Sheet11.Range("G155").Value <> Sheet11.Range("F155").Value Then
MsgBox "ท่านไม่มีสิทธิใช้ข้อมูลหน่วยที่เลือก", vbOKOnly, "โปรแกรมบัตรสินเชื่อเกษตรกร"
Exit Sub
End If
If frmdata.ComboBox3.Value = "" Then
MsgBox "โปรดเลือกหน่วยอำเภอ", vbOKOnly, "โปรแกรมบัตรสินเชื่อเกษตรกร"
Exit Sub
End If
If Sheet47.Range("S1").Value = 0 Then
MsgBox "โปรดทำรายการที่ 3 ก่อนครับ", vbOKOnly, "โปรแกรมบัตรสินเชื่อเกษตรกร"
Exit Sub
End If
If Sheet45.Range("AD3").Value = 0 Then
MsgBox ข้อมูลรับส่งบัตรสินเชื่อเกษตรกรรอบนี้ ไม่มีข้อมูลหน่วยที่ท่านระบุ", "โปรแกรมบัตรสินเชื่อเกษตรกร"
Exit Sub
End If
 'On Error Resume Next
 Application.ScreenUpdating = False
Workbooks("CIF.xlsm").Worksheets("data").Activate
r = 2
Do Until Sheet45.Cells(r, 2).Value = "" 
Sheet45.Range("AG3").Value = Sheet45.Cells(r, 2).Value ส่งค่าข้อมูลของCells(r, 2) ไปที่ AG3 เพื่อไป VLOOKUP หาค่าที่ต้องการและแสดงค่าในSheet45.Range("AG3:AR3").Value
Sheet45.Range("AD4").Value = Sheet45.Cells(r, 6).Value ส่งค่าข้อมูลของCells(r, 6) ไปที่ AD4 เพื่อตรวจสอบว่าตรงกับรหัสหน่วยอำเภอที่เลือกหรือไม่

 With Workbooks("CIF.xlsm").Worksheets("batka") ชีตที่ต้องการส่งไปบันทึกครับ
Set rs = Workbooks("CIF.xlsm").Worksheets("batka").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Set Key = Workbooks("CIF.xlsm").Worksheets("batka").Range("AB1") กำหนดให้ที่ AB1=IF(COUNTIF($B:$B,Z1)>=1,"Active","In Active") โดยที่Z1ชีต batka=AG3 ชีตdata
End With

With Workbooks("CIF.xlsm").Worksheets("data")
Set rt = Workbooks("CIF.xlsm").Worksheets("data").Range("AG4:AR4") ชุดข้อมูลที่จะส่งซึ่งจะมาจากค่า AG3:AR3 ที่ได้ VLOOKUP หาข้อมูลไว้
End With

If Key = "In Active" And Sheet45.Range("AD5").Value = 0 Then   (AD5 จะเท่ากับ 0 หาก ค่าข้อมูลของCells(r, 6) ที่ส่งไปที่ AD4 ตรงกับหน่วยที่เลือก)
Sheet45.Range("AG4:AR4").Value = Sheet45.Range("AG3:AR3").Value
rt.Copy: rs.PasteSpecial xlPasteValues
   Application.CutCopyMode = False
End If
 frmdata.TextBox2.Value = r - 1 (ตัวแสดงให้เห็นว่ามีการรันข้อมูล)
DoEvents
r = r + 1
Loop

ปรากฏว่าเมื่อกดคำสั่งมันก็ส่งแต่ข้อมูลรายการสุดท้ายไป
สมมติมี 6 ราย มันส่งแต่รายที่6 ครับ 1-5 ไม่ส่ง
ผมพยายามสลับบรรทัดคำสั่งก็แก้ไม่ได้ รบกวนสอนหน่อยครับ ขอบคุณครับ

[snasui]

แนบไฟล์ตัวอย่างพร้อม Code มาด้วยจะได้ช่วยทดสอบได้ครับ