Excel Forum

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

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