:!: โปรดทราบ Image
    1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ดครับ Image
    2. การสมัครสมาชิกเพื่อโพสต์คำถาม ดาวน์โหลดไฟล์แนบไปศึกษา ทำตามขั้นตอนด้านล่างครับ
      1. สมัครสมาชิก ดูขั้นตอนตาม Link นี้ครับ => สมัครสมาชิก กรณีลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่นี่ครับ => Reset รหัสผ่านImage
      2. Login เข้าระบบโดยคลิก Login ตรงมุมขวาบนของหน้านี้ Image กรณีมีปัญหาในการเข้าใช้งาน คลิก Link นี้เพื่อแจ้งผู้ดูแลระบบครับ => ติดต่อผู้ดูแลระบบ
    3. เมื่อ Login แล้วสามารถกำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษได้ที่ Link นี้ครับ => ตั้งค่าส่วนตัว Image
    4. วิธีการตั้งและตอบกระทู้ดูได้ที่ Link นี้ครับ => วิธีการตั้งและตอบกระทู้ Image
    5. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ Link นี้ครับ => จัดรูปแบบตัวอักษร และสามารถกำหนดขนาดตัวอักษรใน Browser ได้ที่นี่ครับ ==> กำหนดขนาดตัวอักษรใน Browser Image

copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

ฟอรั่มถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถาม-ตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบ ต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. อธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. ควรแนบตัวอย่างไฟล์มาที่ฟอรั่มนี้เพื่อเพิ่มความสะดวกในการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่น นอกจากนี้ไม่ควรแนบไฟลที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. สำหรับคำถามเกี่ยวกับ VBA ให้ลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน ควรโพสต์ Code ให้แสดงเป็น Code เพื่อสะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. แจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#1

Postby kio2002 » Wed Oct 04, 2017 8:58 pm

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
You do not have the required permissions to view the files attached to this post.

User avatar
puriwutpokin
Silver
Silver
Posts: 931
Joined: Fri Jan 04, 2013 9:49 pm

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#2

Postby puriwutpokin » Wed Oct 04, 2017 9:31 pm

ปรับเป็น

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

kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#3

Postby kio2002 » Fri Oct 06, 2017 8:30 pm

ขอบคุณ 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
You do not have the required permissions to view the files attached to this post.

User avatar
puriwutpokin
Silver
Silver
Posts: 931
Joined: Fri Jan 04, 2013 9:49 pm

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#4

Postby puriwutpokin » Fri Oct 06, 2017 9:00 pm

ปรับเป็น

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


kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#5

Postby kio2002 » Sat Oct 07, 2017 9:49 pm

ขอบคุณ คุณpuriwutpokinครับ ใช้ได้ตรงตามที่ต้องการเลยครับ
พอดีผมมาเพิ่มชื่อชีท 4,5ภายหลัง แล้วกดปุ่มเพื่อสร้างชีทต่อจากชีท3 เป็นชีท4,5ตามลำดับ
แต่ยังติดตรงนี้ครับ ขอบกวนช่วยดูให้อีกทีครับ

Code: Select all

ActiveSheet.Name = r.Cells(i, 1).Value
You do not have the required permissions to view the files attached to this post.

User avatar
puriwutpokin
Silver
Silver
Posts: 931
Joined: Fri Jan 04, 2013 9:49 pm

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#6

Postby puriwutpokin » Sat Oct 07, 2017 9:56 pm

ผมรันก็ได้ปกตินะครับ
You do not have the required permissions to view the files attached to this post.

kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#7

Postby kio2002 » Sat Oct 07, 2017 10:22 pm

อ๋อ หมายถึงถ้ามาเพิ่มชื่อชีท 4,5,.. ไปเรื่อยๆ ภายหลัง โดยไม่ได้ลบชื่อชีท 1,2,3,เดิม
เวลากดปุ่ม อยากให้สร้างชื่อชีท 4,5,... ตามลำดับไปเลยครับ
You do not have the required permissions to view the files attached to this post.

User avatar
puriwutpokin
Silver
Silver
Posts: 931
Joined: Fri Jan 04, 2013 9:49 pm

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#8

Postby puriwutpokin » Sat Oct 07, 2017 10:32 pm

เข้าใจความต้องการแล้วครับปรับตามนี้ครับ

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

kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#9

Postby kio2002 » Sat Oct 07, 2017 10:46 pm

สุดยอดมากครับ ตรงตามที่ต้องการเลยครับ ขอบคุณสมาชิก คุณpuriwutpokinมากๆครับ

kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#10

Postby kio2002 » Thu Oct 19, 2017 8:18 pm

เรียนสมาชิกครับ
พอดีผมปรับ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

ขอบคุณครับ
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 22238
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#11

Postby snasui » Thu Oct 19, 2017 8:55 pm

:D ตัวอย่าง 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

kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#12

Postby kio2002 » Thu Oct 19, 2017 10:13 pm

เรียนอาจารย์ snasui ครับ
ผมลองรันแล้วใช้ได้ตามที่ต้องการครับ แต่ผมเอาไปปรับเปลี่ยนนิดหน่อย
ขอบคุณมากๆเลยครับ
กรณีแบบนี้ ถ้าเราไม่ต้องอ้างอิงชื่อชีทได้ไหมครับ โดยใช้ activesheet แล for =
ส่วน for และ for each การทำงานต่างกันอย่างไรครับ และข้อจำกัดของมัน พอจะมีรายละเอียดไหมครับ

User avatar
snasui
Site Admin
Site Admin
Posts: 22238
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#13

Postby snasui » Fri Oct 20, 2017 6:25 am

:D การ Loop เราไม่ต้องอ้างชื่อชีต ยกเว้นจะใช้เป็นเงื่อนไขว่าต้องพิจารณาชีตใดด้วยเงื่อนไขใดเป็นพิเศษครับ

For...Next กับ For Each...Next ต่างกันที่ For...Next ใช้สำหรับการ Loop ค่าที่เป็นตัวเลขทั้งในแบบขึ้นและลง ส่วน For Each...Next จะใช้ Loop Object ใน Collection เช่น Loop Worksheet ในไฟล์นั้น เป็นต้นครับ

kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#14

Postby kio2002 » Mon Oct 23, 2017 7:17 pm

snasui wrote::D ตัวอย่าง 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
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 22238
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#15

Postby snasui » Mon Oct 23, 2017 9:00 pm

:D ตัวอย่าง 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

kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#16

Postby kio2002 » Mon Oct 23, 2017 10:25 pm

ขอบคุณครับอาจารย์ ตรงตามที่ต้องการเลยครับ code รอบนี้ยาวมาก มึนได้อีก

หลังจากแสดง MsgBox เสร็จ
MsgBox "คุณลืมเปลี่ยนชื่อชีท " & r.Value
ผมจะให้มันรัน procedure ที่อยู่ใน module เดียวกัน ชื่อ procedure "Sub RenameSheet()" ต่อได้ไหมครับ
และเขียนลงอย่างไรครับ ขอบคุณครับ

User avatar
snasui
Site Admin
Site Admin
Posts: 22238
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#17

Postby snasui » Mon Oct 23, 2017 10:31 pm

:D เพิ่ม Call RenameSheet ก่อน End Sub หรือตำแหน่งใด ๆ ที่ต้องการจะให้ Run Code ดังกล่าวครับ

kio2002
Member
Member
Posts: 149
Joined: Thu Sep 20, 2012 8:40 am

Re: copy Sheet อัตโนมัติจากชีทที่กำหนด แล้วเปลี่ยนรายชื่อชีทที่ให้ไว้ล่วงหน้าด้วย VBA

#18

Postby kio2002 » Tue Oct 24, 2017 9:40 am

ได้แล้วครับอาจารย์ ขอบคุณมากๆเลยครับ


Return to “Excel”

Who is online

Users browsing this forum: No registered users and 31 guests