VBA เขียน export Workbook โดยสร้าง Worksheet หลายๆ sheet และกำหนดชื่อ ยังไงครับ

[4ko6yon61]

ต้องการสร้างอีก workbook นึง ที่มี Sheet ทั้ง 7 ชีท ตาม วันต่างๆ ครับ เขียนได้แค่นี้ ครับ ลองใช้ ActiveWorkbook.Sheets.Add แต่ไม่ได้ผล ไม่รู้เขียนผิดหรือเปล่าครับ

Code: Select all

Sub ExportSheetToNewWorkbook()

Dim xPath As String
Dim xWs  As String
Dim xName  As String

xPath = Application.ActiveWorkbook.Path


Application.ScreenUpdating = False
Application.DisplayAlerts = False

MkDir xPath & "\Sheet"
For i = 1 To 7
xName = Sheets("sheet2").Cells(i, "A").Value
    With Sheets("sheet1")
        Sheets("sheet1").Copy
        Sheets("sheet1").name = xName
        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\Sheet\" & "0" & i & "-" & xName & "-test.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.ActiveWorkbook.Close False
    End With
Next

For i = 1 To 7
xName = Sheets("sheet2").Cells(i, "A").Value
    With Sheets("sheet1")
        Sheets("sheet1").Copy
        ................................................................................................................
        ................................................................................................................
        Application.ActiveWorkbook.Close False
    End With
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

[snasui]

ช่วยเล่ามาอย่างละเอียดว่าต้องการจะทำอะไรครับ

คำว่า "อะครับ" ให้ใช้คำว่า "ครับ" แทน
คำว่า "หรือป่าว" ให้ใช้คำว่า "หรือเปล่า" หรือคำว่า "หรือไม่" แทนครับ

ทบทวนกฎการใช้บอร์ดทุกข้อด้านบนซ้ำอีกครั้งครับ

[4ko6yon61]

ต้องการสร้าง workbook เพิ่มอีก 1 ไฟล์ครับ ที่รวม sheet ทั้ง 7 ชีท ที่ export ไปก่อนหน้า ตอนนี้ เขียนได้เเล้วครับ (07--all.xlsm)
แต่ติดปัญาหาตรงที่ แต่ละชีทใน 07--all.xlsm ใช้ปุ่ม macro ไม่ได้ครับ

Code: Select all

Sub ExportSheetToNewWorkbook()

Dim xPath As String
Dim xWs  As String
Dim xName(7)  As String
xName(0) = "Mon"
xName(1) = "Tue"
xName(2) = "Wed"
xName(3) = "Thu"
xName(4) = "Fri"
xName(5) = "Sat"
xName(6) = "Sun"

xPath = Application.ActiveWorkbook.Path


Application.ScreenUpdating = False
Application.DisplayAlerts = False

MkDir xPath & "\Sheet"


For i = 0 To 6
    With Sheets("sheet1")
        Sheets("sheet1").Copy
        Sheets("sheet1").name = xName(i)
        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\Sheet\" & "0" & i & "-" & xName(i) & "-test.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.ActiveWorkbook.Close False
    End With
Next

Sheets("sheet1").Copy
ActiveSheet.name = xName(0)
For i = 1 To 6
Sheets(xName(0)).Copy After:=Sheets(Sheets.Count)
ActiveSheet.name = xName(i)
Next
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\Sheet\" & "0" & i & "-" & "-all.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.ActiveWorkbook.Close False


Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

[snasui]

Macro จะไปด้วยก็ต่อเมื่อ Save As ไฟล์ที่เขียน Code ไปเป็นไฟล์ปลายทางให้มีชีตตามที่ต้องการครับ

ไฟล์ที่สร้างขึ้นใหม่ด้วยวิธีที่โพสต์มาจะไม่มี Macro ติดไปด้วยเพราะไฟล์ใหม่ถูกสร้างด้วย Code จากไฟล์เก่า ยกเว้นเขียนให้ Copy Code จากไฟล์เก่าไปยังไฟล์ใหม่ด้วย ซึ่งปกติจะไม่เลือกทำวิธีนี้เพราะต้อง Add Reference และเขียน Code จัดการกับ VBAProject ซึ่งเป็นเรื่องที่ค่อนข้างวุ่นวายครับ