Page 1 of 1
copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Wed Oct 04, 2017 8:58 pm
by kio2002
copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
สวัสดีครับสมาชิกทุกท่าน
ผมได้นำ code ของอาจารย์ snasui มาปรับใช้ แต่ยังติดขัด
ผมต้องการก๊อปปี้ชีท จาก sheetcopy แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้า โดยรายชื่อชีทจะอยู่ที่ชีท หน้าหลัก
รบกวนสมาชิกทุกท่านช่วยหน่อยครับ ขอบคุณมากครับ
Code: Select all
Sub Button1_Click()
Dim i As Long
Dim r As Range
With Worksheets("หน้าหลัก")
Set r = .Range("A1", .Range("A65536").End(xlUp))
End With
For i = 1 To r.Count
Worksheets("sheetcopy").Copy(After:=Worksheets(Worksheets.Count)) _
.Name = r.Cells(i, 1).Value
Next i
End Sub
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Wed Oct 04, 2017 9:31 pm
by puriwutpokin
ปรับเป็น
Code: Select all
Sub Button1_Click()
Dim i As Long
Dim r As Range
With Worksheets("หน้าหลัก")
Set r = .Range("A1", .Range("A65536").End(xlUp))
End With
For i = 1 To r.Count
Worksheets("sheetcopy").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = r.Cells(i, 1).Value
Next i
End Sub
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Fri Oct 06, 2017 8:30 pm
by kio2002
ขอบคุณ puriwutpokin ครับ ได้ตรงตามที่ต้องการแล้วครับ
แต่พอดีผมปรับ code เพิ่ม แต่ยังติดขัดอยู่
ผมต้องการส่งค่าจากชีท หน้าหลัก ที่เซลล์ b:e ไปยังชื่อชีทที่สร้างตามลำดับ รบกวนช่วยดูให้หน่อยครับ
ขอบคุณมากๆครับ
Code: Select all
Sub Button1_Click()
Dim i As Long
Dim r As Range
Dim sh As Worksheet
With Worksheets("หน้าหลัก")
Set r = .Range("A2", .Range("A100").End(xlUp))
End With
For i = 1 To r.Count
Worksheets("sheetcopy").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = r.Cells(i, 1).Value
Next i
For Each sh In Worksheets
If sh.Name <> "หน้าหลัก" Then
If sh.Name <> "sheetcopy" Then
Worksheets("หน้าหลัก").Range("b2") = sh.Range("a2").Value
End If
End If
Next sh
End Sub
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Fri Oct 06, 2017 9:00 pm
by puriwutpokin
ปรับเป็น
Code: Select all
Sub Button1_Click()
Dim i As Long
Dim r As Range
With Worksheets("หน้าหลัก")
Set r = .Range("A2", .Range("A100").End(xlUp))
End With
For i = 1 To r.Count
Worksheets("sheetcopy").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = r.Cells(i, 1).Value
Worksheets("หน้าหลัก").Cells(i + 1, 2).Resize(, 4).Copy: ActiveSheet.Range("a2").PasteSpecial Paste:=xlPasteValues
Next i
End Sub
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Sat Oct 07, 2017 9:49 pm
by kio2002
ขอบคุณ คุณpuriwutpokinครับ ใช้ได้ตรงตามที่ต้องการเลยครับ
พอดีผมมาเพิ่มชื่อชีท 4,5ภายหลัง แล้วกดปุ่มเพื่อสร้างชีทต่อจากชีท3 เป็นชีท4,5ตามลำดับ
แต่ยังติดตรงนี้ครับ ขอบกวนช่วยดูให้อีกทีครับ
Code: Select all
ActiveSheet.Name = r.Cells(i, 1).Value
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Sat Oct 07, 2017 9:56 pm
by puriwutpokin
ผมรันก็ได้ปกตินะครับ
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Sat Oct 07, 2017 10:22 pm
by kio2002
อ๋อ หมายถึงถ้ามาเพิ่มชื่อชีท 4,5,.. ไปเรื่อยๆ ภายหลัง โดยไม่ได้ลบชื่อชีท 1,2,3,เดิม
เวลากดปุ่ม อยากให้สร้างชื่อชีท 4,5,... ตามลำดับไปเลยครับ
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Sat Oct 07, 2017 10:32 pm
by puriwutpokin
เข้าใจความต้องการแล้วครับปรับตามนี้ครับ
Code: Select all
Sub Button1_Click()
Dim i As Long
Dim r As Range
With Worksheets("หน้าหลัก")
Set r = .Range("A2", .Range("A100").End(xlUp))
End With
For i = Worksheets.Count - i - 1 To r.Count
Worksheets("sheetcopy").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = r.Cells(i, 1).Value
Worksheets("หน้าหลัก").Cells(i + 1, 2).Resize(, 4).Copy: ActiveSheet.Range("a2").PasteSpecial Paste:=xlPasteValues
Next i
End Sub
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Sat Oct 07, 2017 10:46 pm
by kio2002
สุดยอดมากครับ ตรงตามที่ต้องการเลยครับ ขอบคุณสมาชิก คุณpuriwutpokinมากๆครับ
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Thu Oct 19, 2017 8:18 pm
by kio2002
เรียนสมาชิกครับ
พอดีผมปรับcode ให้นำค่าจากชีท"หน้าหลัก"ตั้งแต่เซลล์a2ลงไป ส่งไปยังทุกชีทที่เซลล์ b1 ยกเว้นชีท"หน้าหลัก"
แต่ยังไม่ได้ รบกวนสมาชิกช่วยดูให้หน่อยครับ
Code: Select all
Sub Button1_Click()
Dim i As Long
Dim r As Range
Set r = Worksheets("หน้าหลัก").Range("A2", Worksheets("หน้าหลัก").Range("A100").End(xlUp))
For i = Worksheets.Count - i - 1 To r.Count
With Worksheets("หน้าหลัก")
.Cells(i + 3, 2).Copy: ActiveSheet.Range("b1").PasteSpecial Paste:=xlPasteValues
End With
Next i
End Sub
ขอบคุณครับ
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Thu Oct 19, 2017 8:55 pm
by snasui
ตัวอย่าง Code ครับ
Code: Select all
Sub Button1_Click()
Dim rall As Range, r As Range
With Worksheets("หน้าหลัก")
Set rall = .Range("A2", .Range("A100").End(xlUp))
End With
For Each r In rall
Worksheets(r.Value).Range("a2:d2").Value = r.Offset(0, 1).Resize(1, 4).Value
Next r
End Sub
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Thu Oct 19, 2017 10:13 pm
by kio2002
เรียนอาจารย์ snasui ครับ
ผมลองรันแล้วใช้ได้ตามที่ต้องการครับ แต่ผมเอาไปปรับเปลี่ยนนิดหน่อย
ขอบคุณมากๆเลยครับ
กรณีแบบนี้ ถ้าเราไม่ต้องอ้างอิงชื่อชีทได้ไหมครับ โดยใช้ activesheet แล for =
ส่วน for และ for each การทำงานต่างกันอย่างไรครับ และข้อจำกัดของมัน พอจะมีรายละเอียดไหมครับ
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Fri Oct 20, 2017 6:25 am
by snasui
การ Loop เราไม่ต้องอ้างชื่อชีต ยกเว้นจะใช้เป็นเงื่อนไขว่าต้องพิจารณาชีตใดด้วยเงื่อนไขใดเป็นพิเศษครับ
For...Next กับ For Each...Next ต่างกันที่ For...Next ใช้สำหรับการ Loop ค่าที่เป็นตัวเลขทั้งในแบบขึ้นและลง ส่วน For Each...Next จะใช้ Loop Object ใน Collection เช่น Loop Worksheet ในไฟล์นั้น เป็นต้นครับ
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Mon Oct 23, 2017 7:17 pm
by kio2002
snasui wrote: ตัวอย่าง Code ครับ
Code: Select all
Sub Button1_Click()
Dim rall As Range, r As Range
With Worksheets("หน้าหลัก")
Set rall = .Range("A2", .Range("A100").End(xlUp))
End With
For Each r In rall
Worksheets(r.Value).Range("a2:d2").Value = r.Offset(0, 1).Resize(1, 4).Value
Next r
End Sub
เรียนอาจารย์สันติพงศ์ครับ
จาก codeนี้ ผมนำมาปรับเพิ่ม โดยให้มีเงื่อนไขว่า ให้ตรวจชื่อชีทว่าตรงกันกับชื่อที่ให้อ้างอิงระหว่างเซลล์A2:A100หรือไม่
หากตรงกันทุกชีท ให้ดำเนินการไปตามปกติ แต่หากไม่ตรงกันให้แสดง msgbox ขึ้นมาแจ้ง
รบกวนช่วยดูให้หน่อยครับ ขอบคุณครับ
Code: Select all
If Worksheets(r.Value) = rall Then
Worksheets(r.Value).Range("A2").Value = r.Offset(0, 1).Value
Else
If Worksheets(r.Value) <> rall Then
MsgBox "คุณลืมเปลี่ยนชื่อชีท"
End If
End If
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Mon Oct 23, 2017 9:00 pm
by snasui
ตัวอย่าง Code ครับ
Code: Select all
Dim rall As Range, r As Range
Dim sh As Worksheet, arrShts() As Variant
Dim j As Integer
For j = 2 To ThisWorkbook.Worksheets.Count
ReDim Preserve arrShts(i)
arrShts(i) = ThisWorkbook.Worksheets(j).Name
i = i + 1
Next j
With Worksheets("หน้าหลัก")
Set rall = .Range("A2", .Range("A100").End(xlUp))
End With
For Each r In rall
If Not IsError(Application.Match(r.Value, arrShts, 0)) Then
Worksheets(r.Value).Range("A2").Value = r.Offset(0, 1).Value
Else
MsgBox "คุณลืมเปลี่ยนชื่อชีทเป็น " & r.Value
End If
Next r
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Mon Oct 23, 2017 10:25 pm
by kio2002
ขอบคุณครับอาจารย์ ตรงตามที่ต้องการเลยครับ code รอบนี้ยาวมาก มึนได้อีก
หลังจากแสดง MsgBox เสร็จ
MsgBox "คุณลืมเปลี่ยนชื่อชีท " & r.Value
ผมจะให้มันรัน procedure ที่อยู่ใน module เดียวกัน ชื่อ procedure "Sub RenameSheet()" ต่อได้ไหมครับ
และเขียนลงอย่างไรครับ ขอบคุณครับ
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Mon Oct 23, 2017 10:31 pm
by snasui
เพิ่ม
Call RenameSheet
ก่อน
End Sub
หรือตำแหน่งใด ๆ ที่ต้องการจะให้ Run Code ดังกล่าวครับ
Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA
Posted: Tue Oct 24, 2017 9:40 am
by kio2002
ได้แล้วครับอาจารย์ ขอบคุณมากๆเลยครับ