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

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

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

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

#1

Post 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
You do not have the required permissions to view the files attached to this post.
User avatar
puriwutpokin
Guru
Guru
Posts: 3693
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#2

Post 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
:shock: :roll: :D
kio2002
Member
Member
Posts: 177
Joined: Thu Sep 20, 2012 8:40 am

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

#3

Post 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
You do not have the required permissions to view the files attached to this post.
User avatar
puriwutpokin
Guru
Guru
Posts: 3693
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#4

Post 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

:shock: :roll: :D
kio2002
Member
Member
Posts: 177
Joined: Thu Sep 20, 2012 8:40 am

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

#5

Post by kio2002 »

ขอบคุณ คุณ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
Guru
Guru
Posts: 3693
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#6

Post by puriwutpokin »

ผมรันก็ได้ปกตินะครับ
You do not have the required permissions to view the files attached to this post.
:shock: :roll: :D
kio2002
Member
Member
Posts: 177
Joined: Thu Sep 20, 2012 8:40 am

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

#7

Post by kio2002 »

อ๋อ หมายถึงถ้ามาเพิ่มชื่อชีท 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
Guru
Guru
Posts: 3693
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#8

Post 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
:shock: :roll: :D
kio2002
Member
Member
Posts: 177
Joined: Thu Sep 20, 2012 8:40 am

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

#9

Post by kio2002 »

สุดยอดมากครับ ตรงตามที่ต้องการเลยครับ ขอบคุณสมาชิก คุณpuriwutpokinมากๆครับ
kio2002
Member
Member
Posts: 177
Joined: Thu Sep 20, 2012 8:40 am

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

#10

Post 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
ขอบคุณครับ
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#11

Post by snasui »

: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: 177
Joined: Thu Sep 20, 2012 8:40 am

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

#12

Post by kio2002 »

เรียนอาจารย์ snasui ครับ
ผมลองรันแล้วใช้ได้ตามที่ต้องการครับ แต่ผมเอาไปปรับเปลี่ยนนิดหน่อย
ขอบคุณมากๆเลยครับ
กรณีแบบนี้ ถ้าเราไม่ต้องอ้างอิงชื่อชีทได้ไหมครับ โดยใช้ activesheet แล for =
ส่วน for และ for each การทำงานต่างกันอย่างไรครับ และข้อจำกัดของมัน พอจะมีรายละเอียดไหมครับ
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#13

Post by snasui »

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

For...Next กับ For Each...Next ต่างกันที่ For...Next ใช้สำหรับการ Loop ค่าที่เป็นตัวเลขทั้งในแบบขึ้นและลง ส่วน For Each...Next จะใช้ Loop Object ใน Collection เช่น Loop Worksheet ในไฟล์นั้น เป็นต้นครับ
kio2002
Member
Member
Posts: 177
Joined: Thu Sep 20, 2012 8:40 am

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

#14

Post by kio2002 »

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: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#15

Post by snasui »

: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: 177
Joined: Thu Sep 20, 2012 8:40 am

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

#16

Post by kio2002 »

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

หลังจากแสดง MsgBox เสร็จ
MsgBox "คุณลืมเปลี่ยนชื่อชีท " & r.Value
ผมจะให้มันรัน procedure ที่อยู่ใน module เดียวกัน ชื่อ procedure "Sub RenameSheet()" ต่อได้ไหมครับ
และเขียนลงอย่างไรครับ ขอบคุณครับ
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#17

Post by snasui »

:D เพิ่ม Call RenameSheet ก่อน End Sub หรือตำแหน่งใด ๆ ที่ต้องการจะให้ Run Code ดังกล่าวครับ
kio2002
Member
Member
Posts: 177
Joined: Thu Sep 20, 2012 8:40 am

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

#18

Post by kio2002 »

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