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

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

Code ที่เขียนไว้อยู่ใน Module ใด ชื่ออะไร ติดขัดบรรทัดใดช่วยแจ้งมาด้วยจะได้ตอบต่อไปจากนั้นครับ
ขออภัยครับ Addworksheet ครับผม
Re: สร้างชีทใหม่ตามรายชื่อพนักงาน
Posted: Thu May 03, 2018 8:12 pm
by snasui

ตัวอย่างการปรับ 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

ตัวอย่างการปรับ 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

จำเป็นต้องปรับ Code มาเองก่อนติดตรงไหนค่อยถามกันต่อครับ