ต้องการ copy ชุดข้อมูล พร้อมสร้าง sheet ใหม่

[ekkaluk_suk]

ต้องการ คีย์ข้อมูลในช่องที่ต้องการ และ copy ค่านั้นลงด้านล่างจำนวน 10 แถว พร้อมทั้ง copy ข้อมูลไปสร้าง sheet ใหม่ ตามตัวอย่าง โดย sheet จะสร้างใหม่ทุกครั้ง เมื่อมีการเพิ่มข้อมูล ในคอลัมภ์ C ทุกๆ 10 แถว รบกวนอาจารย์ด้วยครับ

[snasui]

การทำเช่นนั้นต้องอาศัย VBA ผมเขียนเป็นตัวอย่างให้ลองปรับใช้งานก่อน หากปรับใช้แล้วติดปัญหาส่วนไหนอย่างไรค่อยนำ Code ล่าสุดมาถามกันต่อครับ

Code ด้านล่างต้องวางใน Sheet1 (All) ไม่ใช่วางใน Module ใด ๆ ครับ

Code: Select all

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s As Worksheet
    Dim ns As Worksheet
    Dim sr As Range
    
    Application.EnableEvents = False
    With Me
        If Target.Column = 3 And Target.Row > 1 Then
            On Error Resume Next
            Set s = ThisWorkbook.Worksheets(Target.Value)
            If s Is Nothing Then
                On Error GoTo 0
                Set sr = Target.Resize(10)
                sr.FillDown
                Set ns = ThisWorkbook.Worksheets.Add(after:= _
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
                With ns
                    .Name = Target.Value
                    .Range("a1:b1").Value = Array("Code", "Job")
                    .Range("a1:b1").Borders.LineStyle = xlContinuous
                    sr.Offset(0, -1).Resize(, 2).Copy .Range("a2")
                    .Range("a1:b1").EntireColumn.AutoFit
                End With
            Else
                Target.Value = ""
                MsgBox "This sheet name is already exist"
                
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub