Copy Sheetต้นแบบ เป็นหลาย ๆ Sheet

[Pongsun]

คือว่าผมได้ทำการเขียน code vba ออกมาครับ แต่เมื่อรันออกมามันทำการ copy sheet ต้นแบบมาแล้ว 1 sheet แต่เมื่อมันรัน sheet ที่ 2 มันกับเอา Sheet ที่ copy จากsheet ต้นแบบมารันผลต่อเลยครับ ไม่สามารถผมต้องแก้code อย่างไงดีครับ ผมไม่เก่ง code มากครับ

Code: Select all

Private Sub CommandButton6_Click()
        Dim Row As Integer
        Row = 2
        Sheets("set2").Copy
            For Row = 1 To 2000
            On Error Resume Next
                If Sheet1.Cells(Row, 14) = "set2" Then
                    nRow = Sheets("set2").Columns(1).Find(Empty).Row
                        For i = 1 To 13
                            Sheets("set2").Cells(nRow, i) = Sheet1.Cells(Row, i)
                        Next i
                End If
            Next Row
        Dim ow As Integer
        ow = 2
        Sheets("set2").Copy
             For ow = 1 To 2000
                If Sheet1.Cells(ow, 14) = "set1" Then
                    nRow = Sheets("set2").Columns(1).Find(Empty).Row
                        For i = 1 To 13
                            Sheets("set2").Cells(nRow, i) = Sheet1.Cells(ow, i)
                        Next i
                End If
            Next ow
End Sub

[puriwutpokin]

ลองแนบไฟล์ตัวอย่างที่ และอธิบายให้ชัดเจนอีกที่ว่า ต้องการอะไร คือไปสร้างไฟล์ใหม่ หรือสร้างชีทใหม่ในไฟล์เดิม ครับ

[Pongsun]

ลองแนบไฟล์ตัวอย่างที่ และอธิบายให้ชัดเจนอีกที่ว่า ต้องการอะไร คือไปสร้างไฟล์ใหม่ หรือสร้างชีทใหม่ในไฟล์เดิม ครับ

เป็นการสร้าง sheet ใหม่ในไฟล์ใหม่เลยครับ โดยจะcopy จาก sheet เดิมครับ ในไฟล์ที่ผมแนบไปคือ หลักการทำงานตามที่ผมต้องการแล้วครับเมื่อกดปุ่มข้อมูลจะดึงแบ่งออกเป็น 2 กลุ่ม และมันจะcopy จากsheet ไฟล์ฺเดิมออกไปเป็นไฟล์ใหม่ กลุ่มละไฟล์ ครับ เพียงแต่เมื่อผมกดปุ่มไปมันแยกออกเป็น 2 ไฟล์ ไฟล์ของกลุ่ม 1 แต่เมื่อเป็นไฟล์ที่ 2 มันกลับเอาไฟล์ของกลุ่ม 1 มาเติมข้อมูลกลุ่ม 2 ครับ หลักๆเลยคือผมต้องการให้แยกออกเป็น กลุ่มละไฟล์โดยเอาต้นแบบจาก sheet ไฟล์เดิมคับ ผมแนบไฟล์ให้แลัวครับผม

Code: Select all

Private Sub CommandButton6_Click()
        Dim Row As Integer
        Row = 2
        Sheets("set").Copy
            For Row = 1 To 2000
            On Error Resume Next
                If Sheet1.Cells(Row, 14) = "set2" Then
                    nRow = Sheets("set").Columns(1).Find(Empty).Row
                        For i = 1 To 14
                            Sheets("set").Cells(nRow, i) = Sheet1.Cells(Row, i)
                        Next i
                End If
            Next Row
        Dim ow As Integer
        ow = 2
        Sheets("set").Copy
             For ow = 1 To 2000
                If Sheet1.Cells(ow, 14) = "set1" Then
                    nRow = Sheets("set").Columns(1).Find(Empty).Row
                        For i = 1 To 14
                            Sheets("set").Cells(nRow, i) = Sheet1.Cells(ow, i)
                        Next i
                End If
            Next ow
End Sub

[puriwutpokin]

ลองปรับตามนี้ครับ

Code: Select all

Private Sub CommandButton6_Click()
        Dim Row As Integer
        Row = 2
        Sheets("set").Copy
            For Row = 1 To 2000
            On Error Resume Next
                If Sheet1.Cells(Row, 14) = "set2" Then
                    nRow = Sheets("set").Columns(1).Find(Empty).Row
                        For i = 1 To 14
                            Sheets("set").Cells(nRow, i) = Sheet1.Cells(Row, i)
                        Next i
                End If
            Next Row
      ThisWorkbook.Activate
        Dim ow As Integer
        ow = 2
        Sheets("set").Copy
             For ow = 1 To 2000
                If Sheet1.Cells(ow, 14) = "set1" Then
                    nRow = Sheets("set").Columns(1).Find(Empty).Row
                        For i = 1 To 14
                            Sheets("set").Cells(nRow, i) = Sheet1.Cells(ow, i)
                        Next i
                End If
            Next ow
End Sub