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
: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

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
:D การ 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::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

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

Posted: Mon Oct 23, 2017 9:00 pm
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

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

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

Posted: Tue Oct 24, 2017 9:40 am
by kio2002
ได้แล้วครับอาจารย์ ขอบคุณมากๆเลยครับ