Page 1 of 1

สร้างชีทใหม่ตามรายชื่อพนักงาน

Posted: Wed May 02, 2018 1:54 pm
by Daboynut
ต้องการ ปุ่ม สร้างชีทใหม่ตามรายชื่อพนักงาน โดยที่สร้างชีทใหม่พร้อมดึงข้อมูล NAME,IN,OUTไปแสดงแบบไล่ลงมาตามลำดับ
ถ้าเป็นชื่อเดิมให้ดึงข้อมูลเวลา NAME,IN,OUT ไปในชีทที่ชื่อของคนนั้นๆครับ ผมทำได้แค่สร้างชีทตามชื่อ Cell เองครับผม รบกวนด้วยครับ
และอยากให้ทำพร้อมกันทีละ 5 คนได้ด้วยครับ

Re: สร้างชีทใหม่ตามรายชื่อพนักงาน

Posted: Wed May 02, 2018 7:20 pm
by snasui
:D Code ที่เขียนไว้อยู่ใน Module ใด ชื่ออะไร ติดขัดบรรทัดใดช่วยแจ้งมาด้วยจะได้ตอบต่อไปจากนั้นครับ

Re: สร้างชีทใหม่ตามรายชื่อพนักงาน

Posted: Thu May 03, 2018 9:10 am
by Daboynut
snasui wrote: Wed May 02, 2018 7:20 pm :D Code ที่เขียนไว้อยู่ใน Module ใด ชื่ออะไร ติดขัดบรรทัดใดช่วยแจ้งมาด้วยจะได้ตอบต่อไปจากนั้นครับ
ขออภัยครับ Addworksheet ครับผม

Re: สร้างชีทใหม่ตามรายชื่อพนักงาน

Posted: Thu May 03, 2018 8:12 pm
by snasui
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub AddWorkSheets()
    Dim r As Range, rall As Range
'    On Error Resume Next
    With Worksheets("Interface")
        Set rall = .Range("D:D").SpecialCells(xlCellTypeConstants)
    End With
    For Each r In rall.Areas
        If r.Cells(2, 1) <> "" Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
                .Name = r.Cells(2, 1).Value
            r.CurrentRegion.Offset(0, 1).Resize(, 3).Copy
            ActiveSheet.Range("a1").PasteSpecial xlPasteValues
            ActiveSheet.Range("a1").PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End If
    Next r
End Sub

Re: สร้างชีทใหม่ตามรายชื่อพนักงาน

Posted: Fri May 04, 2018 10:14 am
by Daboynut
snasui wrote: Thu May 03, 2018 8:12 pm :D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub AddWorkSheets()
    Dim r As Range, rall As Range
'    On Error Resume Next
    With Worksheets("Interface")
        Set rall = .Range("D:D").SpecialCells(xlCellTypeConstants)
    End With
    For Each r In rall.Areas
        If r.Cells(2, 1) <> "" Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
                .Name = r.Cells(2, 1).Value
            r.CurrentRegion.Offset(0, 1).Resize(, 3).Copy
            ActiveSheet.Range("a1").PasteSpecial xlPasteValues
            ActiveSheet.Range("a1").PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End If
    Next r
End Sub
ขอบคุณมากครับ code ใช้ได้ดีมากครับ
แล้วถ้าอยากจะเพิ่มปุ่มแอดข้อมูล เวลาเข้าออก โดยมีเงื่อนไขคือ ให้เพิ่มข้อมูลไปยัง sheet ที่ชื่อของตัวเองเท่านั้น
แนะนำหน่อยครับ ขอบคุณมากครับผม

Re: สร้างชีทใหม่ตามรายชื่อพนักงาน

Posted: Sat May 05, 2018 5:18 am
by snasui
:D จำเป็นต้องปรับ Code มาเองก่อนติดตรงไหนค่อยถามกันต่อครับ