ขอคำแนะนำอ้างอิงชื่อ Sheet จาก WorkSheet 1 ไป 2

[donut123]

สอบถามผู้รู้ครับ ผมทำ Loop แล้วผมกำหนดชื่อ ชีท ไม่ได้ครับ ขึ้น Type mismatch ครับ

Code: Select all

Sub ¡ÃÍ¡ÃÒ§ҹÊèͧä¢è_6_Çѹ()
Dim WB1 As Workbook
Dim WB2 As Workbook
Set WB1 = ActiveWorkbook
Range(Cells(6, 5), Cells(6, 7)).Copy
Set WB2 = Workbooks.Open("C:\Users\OPY0265\Desktop\Production_Farm\FB_Hatchery\àÍ¡ÊÒÃâç¿Ñ¡\Hatcherry Daily Report", False, False)
        With WB2.Sheets("M2").Range("A1")
        .Formula = "=MATCH(B2,B4:B1048576,0)"
        .Value = .Value
        End With
        Cells(Range("A1"), 19).Select
        Selection.Offset(2, 0).Select
        Selection.PasteSpecial xlPasteValues
        Range("A1").Formula.Delete
        'WB1.Close True
        
   
    Application.ScreenUpdating = True
End Sub

[puriwutpokin]

ไฟล์แนบที่มีโค้ดมาด้วยครับ ต้องเป็นไฟล์ นามสกุล .xls ,.xlb หรือ .xlsm ครับ
แล้วระบุว่า ต้องการทำอะไรกับไฟล์อย่างไรด้วยครับ จะได้สะดวกต่อการตอบของเพื่อนสมาชิกครับ

[donut123]

ผมแนบไฟล์ให้ใหม่นะครับ ผมต้องการให้ ไฟล์ Book1 ส่งข้อมูลยอด1,2,3 ไปยังไฟล์ book2 โดยที่ใช้ คอลัม B เป็นตัวกำหนดเล้า แล้วใช้ B2 เป็นกำหนด Row ในการส่งยอดเข้าในช่วงเวลาที่กำหนด ครับ ปัญหาติดตรงที่ถ้ากำหนดหน้า Sheets ให้โค้ดสามารถส่งได้แต่ต้องพิมพ์หลายครั้ง เลยต้องการใช้ Loop เข้ามาช่วยในการส่งข้อมูลแบบซ้ำๆ แต่ติดที่พอทำแล้วมี Debug Type mismatch ครับเลยอยากขอคำแนะนำจากสมาชิกทุกท่านครับว่าควรแก้ไขอย่างไร ขอบคุณมา ณ ที่นี้ด้วยนะครับ สำหรับคำแนะนำในการโพสและแนบไฟล์

[donut123]

ไฟล์แนบครับ

[puriwutpokin]

ลองดูครับตามนี้ครับ และให้ H7 เปลี่ยน จาก i เป็น 1 ครับ

Code: Select all

Sub กรอกรายงานส่องไข่_6_วัน()
Dim WB1 As Workbook
Dim WB2 As Workbook
On Error Resume Next
Set WB1 = Workbooks("Book1.xlsm")
Set WS = WB1.Sheets(1)
With WS
 For i = 2 To Range("H8")
        .Cells(i, 3).Resize(, 3).Copy
Set WB2 = Workbooks.Open("C:\Users\OPY0265\Desktop\Production_Farm\FB_Hatchery\เอกสารโรงฟัก\Hatcherry Daily Report", False, False)
       WB2.Sheets(WS.Cells(i, 2).Value).Select
       With Range("A1")
       .Formula = "=MATCH(B2,B4:B1048576,0)"
       .Value = .Value
        End With
        Cells(Range("A1") + 3, 7).Select
        Selection.PasteSpecial xlPasteValues
        Range("A1").ClearContents
        'WB1.Close True
        Next i
   End With
    Application.ScreenUpdating = True
End Sub

[donut123]

ได้แล้วครับ ขอบคุณมากเลยครับ