

- กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ดครับ
- การสมัครสมาชิกเพื่อโพสต์คำถาม ดาวน์โหลดไฟล์แนบไปศึกษา ทำตามขั้นตอนด้านล่างครับ
- สมัครสมาชิก ดูขั้นตอนตาม Link นี้ครับ => สมัครสมาชิก กรณีลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่นี่ครับ => Reset รหัสผ่าน
- Login เข้าระบบโดยคลิก Login ตรงมุมขวาบนของหน้านี้
กรณีมีปัญหาในการเข้าใช้งาน คลิก Link นี้เพื่อแจ้งผู้ดูแลระบบครับ => ติดต่อผู้ดูแลระบบ
- สมัครสมาชิก ดูขั้นตอนตาม Link นี้ครับ => สมัครสมาชิก กรณีลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่นี่ครับ => Reset รหัสผ่าน
- เมื่อ Login แล้วสามารถกำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษได้ที่ Link นี้ครับ => ตั้งค่าส่วนตัว
- วิธีการตั้งและตอบกระทู้ดูได้ที่ Link นี้ครับ => วิธีการตั้งและตอบกระทู้
- การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ Link นี้ครับ => จัดรูปแบบตัวอักษร และสามารถกำหนดขนาดตัวอักษรใน Browser ได้ที่นี่ครับ => กำหนดขนาดตัวอักษรใน Browser
รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
Forum rules
- ไม่อนุญาตให้ใช้ภาษาแชทในการถาม-ตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
- ห้ามถามโดยระบุชื่อผู้ตอบ ต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
- อธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
- ควรแนบตัวอย่างไฟล์มาที่ฟอรั่มนี้เพื่อเพิ่มความสะดวกในการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่น นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
- สำหรับคำถามเกี่ยวกับ VBA ให้ลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน ควรโพสต์ Code ให้แสดงเป็น Code เพื่อสะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
- แจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
รบกวนค่ะ พอดีได้งานมาทำ ค่ะ หัวหน้าให้แยก sheet เพื่อ save เป็นไฟล์ใหม่ เปิด youtube เห็นวิธีทำ เหมือนงานที่ได้มา คือแยก sheet เพื่อ save ไฟล์ใหม่ค่ะ พอลองทำดูตามวีดีโอ แต่ขึ้น error ค่ะ รบกวนหน่อยค่ะ ไม่รู้ตรงไหนผิด ลองมาหลายครั้งแล้วค่ะ พอดีงานรีบมากค่ะ หัวหน้ารีบใช้ข้อมูล ขอบคุณนะค่ะ
ขึ้น error ค่ะ
อยากได้ไฟล์ตั้งชื่อตามนี้ค่ะ
27032017กระเป๋า5
27032017กระเป๋า6
27032017เสื้อหนา7
27032017เสื้อแขนยาว8
27032017เสื้อหนา9
ขอบคุณมากนะค่ะ (พอดีพึ่งหัดลองทำค่ะ เนื่องจากต้องแยกชีตจำนวนมากค่ะ)
cc cd ce cf cg ch ci cj data data
ขาย ขาย ขาย ขาย ขาย ขาย ขาย 27032017กระเป๋า5 27032017กระเป๋า5
ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ 27032017กระเป๋า6 27032017กระเป๋า6
ขาย ขาย ขาย ขาย ขาย ขาย ขาย 27032017เสื้อหนา7 27032017เสื้อหนา7
เช่า เช่า เช่า เช่า เช่า เช่า เช่า 27032017เสื้อแขนยาว8 27032017เสื้อแขนยาว8
ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ 27032017เสื้อหนา9 27032017เสื้อหนา9
Sub Macro1()
ThisWorkbook.ActiveSheet.Columns("CP:FY").EntireColumn.Delete
For r = 2 To Range("CM6").End(xlUp).Row
Range("CN2").Value = Range("CM" & r).Value
Xdata = Range("CN2")Value
Range("A1").Select
Selection.CurrentRegion.Select
Range("A1:CK6").AdvancedFiter Action:xlFiterCopy, CriteriaRange:=_
Range ("CN1:CN2"), CopyToRange:=Range("CP1"), Unique:=True
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & " \ " & Xdata & ".xlsx"
ThisWorkbook.Sheets(1).Columns("CP:FY").Copy
Windows(xdata) & ".xlsx").Activate
ActiveSheet.Columns("a:a").EntireColumn.Insert
ThisWorkbook.ActiveSheet.Columns("CP:FY").EntireColumn.Delete
Application.CutCopyMode = False
ActiveWorkbookClose True
Next r
End Sub
Range("A1:CK6").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"CN1:CN2"), CopyToRange:=Range("CP2"), Unique:=True
End Sub
ขึ้น error ค่ะ
อยากได้ไฟล์ตั้งชื่อตามนี้ค่ะ
27032017กระเป๋า5
27032017กระเป๋า6
27032017เสื้อหนา7
27032017เสื้อแขนยาว8
27032017เสื้อหนา9
ขอบคุณมากนะค่ะ (พอดีพึ่งหัดลองทำค่ะ เนื่องจากต้องแยกชีตจำนวนมากค่ะ)
cc cd ce cf cg ch ci cj data data
ขาย ขาย ขาย ขาย ขาย ขาย ขาย 27032017กระเป๋า5 27032017กระเป๋า5
ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ 27032017กระเป๋า6 27032017กระเป๋า6
ขาย ขาย ขาย ขาย ขาย ขาย ขาย 27032017เสื้อหนา7 27032017เสื้อหนา7
เช่า เช่า เช่า เช่า เช่า เช่า เช่า 27032017เสื้อแขนยาว8 27032017เสื้อแขนยาว8
ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ ซื้อ 27032017เสื้อหนา9 27032017เสื้อหนา9
Sub Macro1()
ThisWorkbook.ActiveSheet.Columns("CP:FY").EntireColumn.Delete
For r = 2 To Range("CM6").End(xlUp).Row
Range("CN2").Value = Range("CM" & r).Value
Xdata = Range("CN2")Value
Range("A1").Select
Selection.CurrentRegion.Select
Range("A1:CK6").AdvancedFiter Action:xlFiterCopy, CriteriaRange:=_
Range ("CN1:CN2"), CopyToRange:=Range("CP1"), Unique:=True
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & " \ " & Xdata & ".xlsx"
ThisWorkbook.Sheets(1).Columns("CP:FY").Copy
Windows(xdata) & ".xlsx").Activate
ActiveSheet.Columns("a:a").EntireColumn.Insert
ThisWorkbook.ActiveSheet.Columns("CP:FY").EntireColumn.Delete
Application.CutCopyMode = False
ActiveWorkbookClose True
Next r
End Sub
Range("A1:CK6").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"CN1:CN2"), CopyToRange:=Range("CP2"), Unique:=True
End Sub
You do not have the required permissions to view the files attached to this post.
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ขอโทษค่ะ Range("A1:CK6").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"CN1:CN2"), CopyToRange:=Range("CP2"), Unique:=True
End Sub (3 บรรทัดสุดท้าย copy หลงไปค่ะ) ขอบคุณมากค่ะ
"CN1:CN2"), CopyToRange:=Range("CP2"), Unique:=True
End Sub (3 บรรทัดสุดท้าย copy หลงไปค่ะ) ขอบคุณมากค่ะ
- puriwutpokin
- Gold
- Posts: 1441
- Joined: Fri Jan 04, 2013 9:49 pm
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
จาก VBA โค้ดที่ให้มาดูนั้น ผิดหลายจุดเลยครับ ต้องถามก่อนว่า เจตนาที่ ต้องการออกมาเป็นหน้าตา แบบไหน ทำตัวอย่าง แบบที่ต้องการมาดู
แล้วโค้ดที่ให้มาดู ก็เหมือนมีการปรับแต่งผิด รูปแบบไปจนไม่ชัดเจนว่า ลักษณะงานนั้นเป็นอย่างไรครับ ลองทำตามที่แจ้งก่อนละครับ ตัวอย่างไฟล์ที่ต้องการว่ามีข้อมูลอะไรบ้างครับ แล้วเพื่อนๆสมาชิกจะได้เข้าถึงปัญหาได้เร็วขึ้นครับ
แล้วโค้ดที่ให้มาดู ก็เหมือนมีการปรับแต่งผิด รูปแบบไปจนไม่ชัดเจนว่า ลักษณะงานนั้นเป็นอย่างไรครับ ลองทำตามที่แจ้งก่อนละครับ ตัวอย่างไฟล์ที่ต้องการว่ามีข้อมูลอะไรบ้างครับ แล้วเพื่อนๆสมาชิกจะได้เข้าถึงปัญหาได้เร็วขึ้นครับ

- snasui
- Site Admin
- Posts: 23138
- Joined: Sun Jan 24, 2010 12:33 pm
- Location: Songkhla, Thailand
- Contact:
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ


snasui (คนควน)
MBA in Accounting, MVP-Excel (2010-2017), MOS
Index, Match, Small, Sumif, Countif, Frequency, Sumproduct, Mmult, Lookup, Vlookup, Indirect, Conditional Formatting, Isnumber, Search, PivotTable, Array, Data Validation


Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ขอบคุณนะค่ะ พอดีข้อมูลเต็มไฟล์ใหญ่มากมีประมาณ20000บรรทัดค่ะ มีคอลัมภ์ตั้งแต่ a-cj ค่ะ เลยยกตัวอย่างไฟล์สั้นๆ มาค่ะ
พอดีลองทำตาม youtubeอันนี้ค่ะ https://youtu.be/p2I5xYTHlzE,และhttps:/ ... 0gXMCY2ITc ค่ะ แต่ขึ้นerror ตลอดค่ะ ขอบคุณมากนะค่ะ ลองทำตามหลายหน ไม่รู้ตรงไหนปิด พอดีไม่เคยทำเลย กำลังพยายามศึกษาค่ะ
พอดีลองทำตาม youtubeอันนี้ค่ะ https://youtu.be/p2I5xYTHlzE,และhttps:/ ... 0gXMCY2ITc ค่ะ แต่ขึ้นerror ตลอดค่ะ ขอบคุณมากนะค่ะ ลองทำตามหลายหน ไม่รู้ตรงไหนปิด พอดีไม่เคยทำเลย กำลังพยายามศึกษาค่ะ
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
no data value data data
1 data11 22 data11 data11
2 data8 40 data8
3 data7 31 data7
4 data7 13 data9
5 data9 16 data1
6 data8 39 data12
7 data1 80 data3
8 data7 77 data5
9 data12 45 data4
10 data3 79 data10
11 data5 26 data2
12 data5 11 data6
13 data5 21
14 data4 40
15 data12 32
16 data12 52
17 data11 77
18 data8 96
ไฟล์เหมือนแบบนี้ค่ะ รบกวนค่ะ ขอบคุณมากค่ะ ขอโทษค่ะ หาวิธีแนบโค้ดข้อ 5 ไม่เจอค่ะ โค้ดนี้พิมพ์เหมือนในyoutube ค่ะ ไฟล์งานที่จะได้มาเป็นแบบนี้ค่ะ แต่แถวยาวกว่าค่ะ
Sub Macro1()
ThisWorkbook.ActiveSheet.Columns("H:J").EntireColumn.Delete
For r = 2 To Range("E19").End(xlUp).Row
Range("F2").Value = Range("e" & r).Value
Xdata = Range("F2")Value
Range("A1").Select
Selection.CurrentRegion.Select
Range("A1:CK6").AdvancedFiter Action:xlFiterCopy, CriteriaRange:=_
Range ("F1:F2"), CopyToRange:=Range("H1"), Unique:=True
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & " \ " & Xdata & ".xlsx"
ThisWorkbook.Sheets(1).Columns("H:J").Copy
Windows(xdata) & ".xlsx").Activate
ActiveSheet.Columns("a:a").EntireColumn.Insert
ThisWorkbook.ActiveSheet.Columns("H:J").EntireColumn.Delete
Application.CutCopyMode = False
ActiveWorkbookClose True
Next r
End Sub
1 data11 22 data11 data11
2 data8 40 data8
3 data7 31 data7
4 data7 13 data9
5 data9 16 data1
6 data8 39 data12
7 data1 80 data3
8 data7 77 data5
9 data12 45 data4
10 data3 79 data10
11 data5 26 data2
12 data5 11 data6
13 data5 21
14 data4 40
15 data12 32
16 data12 52
17 data11 77
18 data8 96
ไฟล์เหมือนแบบนี้ค่ะ รบกวนค่ะ ขอบคุณมากค่ะ ขอโทษค่ะ หาวิธีแนบโค้ดข้อ 5 ไม่เจอค่ะ โค้ดนี้พิมพ์เหมือนในyoutube ค่ะ ไฟล์งานที่จะได้มาเป็นแบบนี้ค่ะ แต่แถวยาวกว่าค่ะ
Sub Macro1()
ThisWorkbook.ActiveSheet.Columns("H:J").EntireColumn.Delete
For r = 2 To Range("E19").End(xlUp).Row
Range("F2").Value = Range("e" & r).Value
Xdata = Range("F2")Value
Range("A1").Select
Selection.CurrentRegion.Select
Range("A1:CK6").AdvancedFiter Action:xlFiterCopy, CriteriaRange:=_
Range ("F1:F2"), CopyToRange:=Range("H1"), Unique:=True
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & " \ " & Xdata & ".xlsx"
ThisWorkbook.Sheets(1).Columns("H:J").Copy
Windows(xdata) & ".xlsx").Activate
ActiveSheet.Columns("a:a").EntireColumn.Insert
ThisWorkbook.ActiveSheet.Columns("H:J").EntireColumn.Delete
Application.CutCopyMode = False
ActiveWorkbookClose True
Next r
End Sub
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
พิมพ์ตามใน youtubeค่ะ ตาม book2 รบกวนหน่อยค่ะ ลองทำหลายหนไม่ได้เลยขึ้น errorตลอดเลยค่ะ (post ไม่ค่อยเป็น ขอโทษนะค่ะ) ปกติจะเข้ามาดูปัญหาตลอด เพราะมีพี่ๆ ถามตรงที่อยากรู้ตลอด แต่เรื่องแยกไฟล์มากๆ ไม่มี เลย post ค่ะ
Re: รบกวนค่วะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
โทษค่ะ book2 ไฟล์แนบไม่ไป เดียวลองใหม่นะค่ะ
You do not have the required permissions to view the files attached to this post.
- snasui
- Site Admin
- Posts: 23138
- Joined: Sun Jan 24, 2010 12:33 pm
- Location: Songkhla, Thailand
- Contact:
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ


snasui (คนควน)
MBA in Accounting, MVP-Excel (2010-2017), MOS
Index, Match, Small, Sumif, Countif, Frequency, Sumproduct, Mmult, Lookup, Vlookup, Indirect, Conditional Formatting, Isnumber, Search, PivotTable, Array, Data Validation


Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
Code: Select all
Sub Macro1()
ThisWorkbook.ActiveSheet.Columns("H:J").EntireColumn.Delete
For r = 2 To Range("E19").End(xlUp).Row
Range("F2").Value = Range("e" & r).Value
Xdata = Range("F2")Value
Range("A1").Select
Selection.CurrentRegion.Select
Range("A1:CK6").AdvancedFiter Action:xlFiterCopy, CriteriaRange:=_
Range ("F1:F2"), CopyToRange:=Range("H1"), Unique:=True
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & " \ " & xdata & ".xlsx"
ThisWorkbook.Sheets(1).Columns("H:J").Copy
Windows(xdata) & ".xlsx").Activate
ActiveSheet.Columns("a:a").EntireColumn.Insert
ThisWorkbook.ActiveSheet.Columns("H:J").EntireColumn.Delete
Application.CutCopyMode = False
ActiveWorkbookClose True
Next r
End Sub
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ขอบคุณมากนะค่ะ
- puriwutpokin
- Gold
- Posts: 1441
- Joined: Fri Jan 04, 2013 9:49 pm
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ตามที่แจ้งไปข้างต้นครับ ต้องการ กรองข้อมูล แล้ว คัดลอกไปสร้างเป็นไฟล์ใหม่ชื่อตาม เซลใช่ไหมครับ ลองแนบไฟล์ที่เป็นคำตอบของ ตัวอย่างที่ต้องการ ว่า อะไรมาอย่างไร แล้วไปสร้างมีอะไรเป็นเงื่อนไขครับ

Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ใช่ค่ะ เหมือนมีไฟล์ผลรวม auto filler แล้วแตกไฟล์ ไปสร้างworksheetใหม่และsave เป็นชื่อ data 1 ,data2 ,data3 ไปจนครบทุกรายการในช่องคอลัมภ์e ในไฟล์ที่ชื่อไฟล์ data อันใหม่ค่ะ ขอบคุณมากค่ะ
You do not have the required permissions to view the files attached to this post.
- puriwutpokin
- Gold
- Posts: 1441
- Joined: Fri Jan 04, 2013 9:49 pm
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ปรับโค้ดเป็น
Code: Select all
Sub Test()
Dim xdata As String
For r = 2 To Range("E19").End(xlUp).Row
ThisWorkbook.ActiveSheet.Columns("H:J").EntireColumn.Delete
Range("F2").Value = Range("E" & r).Value
xdata = Range("F2").Value
Range("A1").Select
Selection.CurrentRegion.Select
Range("A1:C19").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"F1:F2"), CopyToRange:=Range("H1"), Unique:=True
ActiveSheet.Columns("H:J").Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & xdata & ".xlsx"
Application.CutCopyMode = False
ActiveWorkbook.Close True
Next r
End Sub

Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ขอบคุณมากนะค่ะ
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ขอบคุณค่ะ ทำตามขั้นตอนอันนี้ค่ะ ไม่รู้ทำตรงไหนผิดค่ะ
You do not have the required permissions to view the files attached to this post.
- puriwutpokin
- Gold
- Posts: 1441
- Joined: Fri Jan 04, 2013 9:49 pm
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ลองแนบไฟล์ที่ใส่โค้ดมาดูกันครับ

Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
พอดีมาหาหมอ ตอนเย็นๆกลับค่ะเดียวส่งไฟล์ไปให้นะค่ะ ขอบคุณมากค่ะ
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ไฟล์ใส่ code ขอบคุณนะค่ะ
You do not have the required permissions to view the files attached to this post.
- puriwutpokin
- Gold
- Posts: 1441
- Joined: Fri Jan 04, 2013 9:49 pm
Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
ลองดูตามไฟล์แนบนะครับ ผมก็คัดลอกมาลงปกติครับ แต่อันหนึ่งที่ต้องเป็น คือ data ควรมีจำนวนเลขเท่ากันเช่น
data11
data01
ไม่ใช่
data11
data1
เพราะเวลาดึงข้อมูลมามันจะไม่ถูกต้องครับ
data11
data01
ไม่ใช่
data11
data1
เพราะเวลาดึงข้อมูลมามันจะไม่ถูกต้องครับ
You do not have the required permissions to view the files attached to this post.
