Page 1 of 1
อยากให้ copy ข้อมูลทั้งแถวเมื่อเจอเงื่อนไขที่กำหนด (พนักงานผลิต1)
Posted: Thu May 19, 2022 3:23 pm
by Xcelvba
อยากให้ copy ข้อมูลทั้งแถวเมื่อเจอเงื่อนไขที่กำหนด (พนักงานผลิต1) จาก Sheet1 ไปชีท Emp1 ครับ
Code: Select all
Sub Click11111()
If Range("A1").Value = "" Then
MsgBox "โปรดระบุข้อมูลให้ครบถ้วน", vbCritical + vbOKOnly, "แจ้งเตือน"
Else
Dim mylastrow As Long
mylastrow = Sheets("Emp1").Range("A" & Rows.Count).End(xlUp).Row + 1
' Range("A9:D20").Copy
If (Range("F3:F99")) = "พนักงานผลิต 1" Then
Sheets("Emp1").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
End If
' Sheets("sheet1").Range("D7").ClearContents
MsgBox "บันทึกรายการเรียบร้อยแล้ว ", vbInformation + vbOKOnly, "แจ้งให้ทราบ"
End If
End Sub
Code: Select all
If (Range("F3:F99")) = "พนักงานผลิต 1" Then
Sheets("Emp1").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
End If
ขอคำแนะนำหน่อยครับ
Re: อยากให้ copy ข้อมูลทั้งแถวเมื่อเจอเงื่อนไขที่กำหนด (พนักงานผลิต1)
Posted: Thu May 19, 2022 5:48 pm
by puriwutpokin
ปรับดูตามนี้ครับ
Code: Select all
Sub Click11111()
Dim i As Long
Dim mylastrow As Long
' Range("A9:D20").Copy
With Sheets("Sheet1")
If .Range("A1").Value = "" Then
MsgBox "โปรดระบุข้อมูลให้ครบถ้วน", vbCritical + vbOKOnly, "แจ้งเตือน"
Else
For i = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
If .Range("F" & i) = "พนักงานผลิต 1" Then
.Range("A" & i).Resize(, 11).Copy
mylastrow = Sheets("Emp1").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Emp1").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
End If
Next i
' Sheets("sheet1").Range("D7").ClearContents
MsgBox "บันทึกรายการเรียบร้อยแล้ว ", vbInformation + vbOKOnly, "แจ้งให้ทราบ"
End If
End With
End Sub
Re: อยากให้ copy ข้อมูลทั้งแถวเมื่อเจอเงื่อนไขที่กำหนด (พนักงานผลิต1)
Posted: Fri May 20, 2022 8:27 am
by Xcelvba
puriwutpokin wrote: ↑Thu May 19, 2022 5:48 pm
ปรับดูตามนี้ครับ
Code: Select all
Sub Click11111()
Dim i As Long
Dim mylastrow As Long
' Range("A9:D20").Copy
With Sheets("Sheet1")
If .Range("A1").Value = "" Then
MsgBox "โปรดระบุข้อมูลให้ครบถ้วน", vbCritical + vbOKOnly, "แจ้งเตือน"
Else
For i = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
If .Range("F" & i) = "พนักงานผลิต 1" Then
.Range("A" & i).Resize(, 11).Copy
mylastrow = Sheets("Emp1").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Emp1").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
End If
Next i
' Sheets("sheet1").Range("D7").ClearContents
MsgBox "บันทึกรายการเรียบร้อยแล้ว ", vbInformation + vbOKOnly, "แจ้งให้ทราบ"
End If
End With
End Sub
ได้แล้วขอบคุณครับ สอบถามเพิ่มเติมครับ
Resize(,11) resize คืออะไรครับ
Re: อยากให้ copy ข้อมูลทั้งแถวเมื่อเจอเงื่อนไขที่กำหนด (พนักงานผลิต1)
Posted: Fri May 20, 2022 9:00 am
by puriwutpokin
Xcelvba wrote: ↑Fri May 20, 2022 8:27 am
puriwutpokin wrote: ↑Thu May 19, 2022 5:48 pm
ปรับดูตามนี้ครับ
Code: Select all
Sub Click11111()
Dim i As Long
Dim mylastrow As Long
' Range("A9:D20").Copy
With Sheets("Sheet1")
If .Range("A1").Value = "" Then
MsgBox "โปรดระบุข้อมูลให้ครบถ้วน", vbCritical + vbOKOnly, "แจ้งเตือน"
Else
For i = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
If .Range("F" & i) = "พนักงานผลิต 1" Then
.Range("A" & i).Resize(, 11).Copy
mylastrow = Sheets("Emp1").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Emp1").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
End If
Next i
' Sheets("sheet1").Range("D7").ClearContents
MsgBox "บันทึกรายการเรียบร้อยแล้ว ", vbInformation + vbOKOnly, "แจ้งให้ทราบ"
End If
End With
End Sub
ได้แล้วขอบคุณครับ สอบถามเพิ่มเติมครับ
Resize(,11) resize คืออะไรครับ
.Range("A" & i).Resize(, 11).Copy คือขยายช่วงคัดลอกข้อมูลจากคอลัมน์ A ไปอีก 11 คอลัมน์ ครับ
Re: อยากให้ copy ข้อมูลทั้งแถวเมื่อเจอเงื่อนไขที่กำหนด (พนักงานผลิต1)
Posted: Fri May 20, 2022 9:27 am
by Xcelvba
puriwutpokin wrote: ↑Fri May 20, 2022 9:00 am
Xcelvba wrote: ↑Fri May 20, 2022 8:27 am
puriwutpokin wrote: ↑Thu May 19, 2022 5:48 pm
ปรับดูตามนี้ครับ
Code: Select all
Sub Click11111()
Dim i As Long
Dim mylastrow As Long
' Range("A9:D20").Copy
With Sheets("Sheet1")
If .Range("A1").Value = "" Then
MsgBox "โปรดระบุข้อมูลให้ครบถ้วน", vbCritical + vbOKOnly, "แจ้งเตือน"
Else
For i = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
If .Range("F" & i) = "พนักงานผลิต 1" Then
.Range("A" & i).Resize(, 11).Copy
mylastrow = Sheets("Emp1").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Emp1").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
End If
Next i
' Sheets("sheet1").Range("D7").ClearContents
MsgBox "บันทึกรายการเรียบร้อยแล้ว ", vbInformation + vbOKOnly, "แจ้งให้ทราบ"
End If
End With
End Sub
ได้แล้วขอบคุณครับ สอบถามเพิ่มเติมครับ
Resize(,11) resize คืออะไรครับ
.Range("A" & i).Resize(, 11).Copy คือขยายช่วงคัดลอกข้อมูลจากคอลัมน์ A ไปอีก 11 คอลัมน์ ครับ
ขอบคุณครับ
