RE: MACRO to save worksheets as seperate files ?

stelmarkov · Jun 6, 2011

RE: MACRO to save worksheets as seperate files ?

Hello, <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com

ffice

ffice" /><o

></o

>
I've found in your archive the Macro code Posted by Dank on November 14, 2001 12:51 AM re how to Saves worksheets as separate files from one main workbook<o

></o

>
<o

></o

>
This code does save the worksheets as a separate files and that is exactly what I’ve been looking for however <o

></o

>
<o

></o

>
1) I don't need to save each worksheet from my master work book e.g I need to save only 20 separate files
<o

> </o

>
How do I amend the below code posted by Dank ? Can we specify in the code the range of the worksheets I need to save ? <o

></o

>
<o

> </o

>
Please note that I am a beginner and I found the below code a bit simple and understanding so is it possible to amend the below code to my need
PS. The Worksheets that I need to copy and distribute are named with different Doctors Surnames<o

></o

>
<o

> </o

>
2) I work in Excel 2007 but most of my master workbooks are saved in .xls and not in .xlsx as we send the files to external users and not every user have latest version of excel, Dank’s macro currently saves all files in .xlsx<o

></o

>
<o

> </o

>
I’ve tried to amend the following Save As macro to <o

></o

>
wbDest.SaveAs strSavePath & sht.Name & " " & Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yy") & ".xls")
<o

> </o

>
The Marco saves the file with ext .xls BUT when I open the file, message says that” The file is saved in different format than specified in the file extension” Where in the macro can you specify the extension of the file then?<o

></o

>
<o

> </o

>
<o

></o

>I also tried to amend / add the following But I am getting the message “Object Variable or with block variable not set”<o

></o

>
<o> </o>
Dim strFile As String<o

></o

>
strFile = Dir(strSavePath & sht.Name & " " & Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yy") & ".xls")<o

></o

>
wbDest.SaveAs strFile<o

></o

>
<o

> </o

>
<o

>Thanking you in advance</o

>
<o

>Kind Regards,</o

>
<o

>Stal</o

>
<o

> </o

>
Please refer to the Macro posted by Dank <o></o>
Sub CreateWorkbooks()
'Creates an individual workbook for each worksheet in the active workbook.
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object 'Could be chart, worksheet, Excel 4.0 macro,etc.
Dim strSavePath As String <o

></o

>
<o

> </o

>
On Error GoTo ErrorHandler<o

></o

>
<o

></o

>
Application.ScreenUpdating = False 'Don't show any screen movement <o

></o

>
strSavePath = "C:\Temp\" 'Change this to suit your needs <o

></o

>
<o

> </o

>
Set wbSource = ActiveWorkbook <o

></o

>
For Each sht In wbSource.Sheets
sht.Copy
Set wbDest = ActiveWorkbook
wbDest.SaveAs strSavePath & sht.Name
wbDest.Close 'Remove this if you don't want each book closed after saving.
Next <o

></o

>
Application.ScreenUpdating = True <o

></o

>
Exit Sub <o

></o

>
ErrorHandler: 'Just in case something hideous happens
MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
End Sub

AMAS · Jun 6, 2011

Re: MACRO to save worksheets as seperate files ?

Maybe try this:

Code:

Option Explicit
Sub CreateWorkbooks()
'Creates an individual workbook for each worksheet in the active workbook.
Dim sht                     As Object       'Could be chart, worksheet, Excel 4.0 macro,etc.
Dim wbDest                  As Workbook
Dim wbSource                As Workbook
Dim strSavePath             As String
Dim SavePath                As String
Dim screenUpdateState       As Variant
Dim statusBarState          As Variant
Dim eventsState             As Variant
Dim calcState               As Variant
 
On Error GoTo ErrorHandler
' Turn off some Excel functionality so your code runs faster
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    calcState = Application.Calculation
    eventsState = Application.EnableEvents
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
 
' Application.ScreenUpdating = False 'Don't show any screen movement
  strSavePath = "C:\Temp\" 'Change this to suit your needs
' Copy Worksheet
  Set wbSource = ActiveWorkbook
      For Each sht In wbSource.Sheets(Array(2, 3)) ' this will save the second and third sheets and so on
                                                   ' you change this to sheet names (e.g. "Sheet1","Sheet2",etc.)
          sht.Copy
              Set wbDest = ActiveWorkbook
 
            ' Save file in original folder, but as xls file format
                SavePath = strSavePath & sht.Name & " " & Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yy") & ".xls"
                wbDest.SaveAs Filename:=SavePath, FileFormat:=xlWorkbookNormal, CreateBackup:=False
                wbDest.Close 'Remove this if you don't want each book closed after saving.
      Next
' Turn Excel functionality back on
    With Application
        .DisplayStatusBar = statusBarState
        .Calculation = calcState
        .EnableEvents = eventsState
        .ScreenUpdating = screenUpdateState
    End With
Exit Sub
ErrorHandler: 'Just in case something hideous happens
MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
' Turn Excel functionality back on
    With Application
        .DisplayStatusBar = statusBarState
        .Calculation = calcState
        .EnableEvents = eventsState
        .ScreenUpdating = screenUpdateState
    End With
End Sub

AMAS

markmzz · Jun 6, 2011

Re: MACRO to save worksheets as seperate files ?

Stelmarkov,

Or try this:

Code:

Sub CreateWorkbooks()
'Author: Dank
'Minor modifications: Markmzz
'Creates an individual workbook for each chose worksheet in the active workbook.
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim ws As Worksheet
    Dim strSavePath As String
 
    On Error GoTo ErrorHandler
 
    Application.ScreenUpdating = False 'Don't show any screen movement
    'Save the worksheets files in the same path of the Main workbook file
    strSavePath = ThisWorkbook.Path & "\" 'Change this to suit your needs
 
    Set wbSource = ActiveWorkbook
 
    'Only save the worksheets Plan1 and Plan2
    For Each ws In wbSource.Worksheets(Array("Plan1", "Plan2"))
        ws.Copy
        Set wbDest = ActiveWorkbook
        'Save the worksheets in the Excel xls format (97-2003)
        wbDest.SaveAs Filename:=strSavePath & ws.Name & " " & _
            Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yy") & ".xls", _
            FileFormat:=xlExcel8
        wbDest.Close 'Remove this if you don't want each book closed after saving.
    Next ws
    Application.ScreenUpdating = True
 
    Set wbSource = Nothing
    Set wbDest = Nothing
    Exit Sub
 
ErrorHandler:     'Just in case something hideous happens
    MsgBox "An error has occurred. Error number=" & Err.Number & _
        ". Error description=" & Err.Description & "."
    Set wbSource = Nothing
    Set wbDest = Nothing
End Sub

Markmzz

stelmarkov · Jun 6, 2011

Re: MACRO to save worksheets as seperate files ?

Hello,

Thank you so much...its fantastic!!!

1) Please note, I have specified the tabs I want to copy e.g starting from 36, 37, 38, 39,40, 45 etc so the macro saved for me 4 files

For Each sht In wbSource.Sheets(Array(31, 32, 33, 34, 35, 36, 39, 40, 45))

While saving individual tabs I realised that I also need to save 2 or 3 tabs together as separate files and the file name will be from first sheet

e.g : 1) 5,6 & 8 tabs the file name will be from sht #5

and 2) 9 & 10 tabs the file name will be from sht #9

My master file contains the Statments for each doctor but also I have partnerships where instead of 1 worksheet I need to send them 2 or 3

Can I add this to the above array or it is better to have a separate macro to this or to add another Dim sht2 As Object ?

2) As I am saving the files in .xls I get a CheckCompatibility Checks everytime the new workbook copies and saves

Is it possible to have CheckCompatibility = False when for we copy the worksheets ?

Thanking you in advance for help.
Kind Regards
Stel

markmzz · Jun 6, 2011

Re: MACRO to save worksheets as seperate files ?

Stelmarkov

Try this:

Code:

Sub CreateWorkbooks()
'Author: Dank
'Minor modifications: Markmzz
 
'Creates an individual workbook for each chose worksheet in the active workbook.
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim ws As Object
    Dim strSavePath As String
    Dim i As Integer
 
    On Error GoTo ErrorHandler
 
    Application.ScreenUpdating = False 'Don't show any screen movement
    strSavePath = ThisWorkbook.Path & "\" 'Change this to suit your needs
    Set wbSource = ActiveWorkbook
    For Each ws In wbSource.Sheets(Array(1, 2))
            ws.Copy
            Set wbDest = ActiveWorkbook
            wbDest.SaveAs Filename:=strSavePath & ws.Name & " " & _
                Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yy") & ".xls", _
                FileFormat:=xlExcel8
            wbDest.Saved = False
            wbDest.CheckCompatibility = False
            wbDest.Close SaveChanges:=True 'Remove this if you don't want each book closed after saving.
    Next ws
    i = 1
    For Each ws In wbSource.Sheets(Array(3, 4))
        If i = 1 Then
            ws.Copy
            Set wbDest = ActiveWorkbook
            wbDest.SaveAs Filename:=strSavePath & ws.Name & " " & _
                Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yy") & ".xls", _
                FileFormat:=xlExcel8
            wbDest.CheckCompatibility = False
         Else
            ws.Copy Before:=wbDest.Sheets(1)
        End If
        i = i + 1
    Next ws
    wbDest.Close SaveChanges:=True 'Remove this if you don't want each book closed after saving.
    Application.ScreenUpdating = True
 
    Set wbSource = Nothing
    Set wbDest = Nothing
    Exit Sub
 
ErrorHandler:     'Just in case something hideous happens
    MsgBox "An error has occurred. Error number=" & Err.Number & _
        ". Error description=" & Err.Description & "."
    Set wbSource = Nothing
    Set wbDest = Nothing
End Sub

Markmzz

stelmarkov · Jun 7, 2011

Re: MACRO to save worksheets as seperate files ?

Hello Markmzz<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com

ffice

ffice" /><o

></o

>
<o

></o

>
Many many thanks for taking your time and helping me out! Today at work I've tested all macros and they will save me lots of time especially at the month end deadlines !<o

></o

>
<o

></o

>
I have few more questions hopefully the last ones:

<o

></o

>
<o

></o

>
In your last reply you wrote the code that will save the tabs 3 & 4 as in one file ..<o

></o

>
<o

></o

>
"For Each ws In wbSource.Sheets(Array(3, 4))<o

></o

>
After testing the macro I wanted to know what would be the code if you want also to save tabs 6 & 7 from the same file ( I don't have this case now but I will be combining my master files and I will need that)<o

></o

>
<o

></o

>
Please note I've played with macro and tried to amend it but I was unsuccessful as I don't know how as yet<o

></o

>
<o

></o

>
2) Pasting Values / Eliminating the links to the external files<o

></o

>
<o

></o

>
I added coping and pasting values when saving single or multiple sheets as separate files. The macro works fine when I save individual sheets but when I save e.g sheets (Array(3, 4)) The pasting values only happening in the sheets 3 and not sheet 4 <o

></o

>
<o

></o

>
Next ws
i = 1
For Each ws In wbSource.Sheets(Array(3, 4))
If i = 1 Then

ws.Copy
Set wbDest = ActiveWorkbook

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

wbDest.SaveAs Filename:=strSavePath & ws.Name & " " & _
Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yy") & ".xls", _
FileFormat:=xlExcel8
wbDest.CheckCompatibility = False<o

></o

>
<o

></o

>
In order to fix it do I need to specify the pasting for wbDest = ActiveWorkbook for sheets 1 and 2 separately ? ( The new copied file will only have sheets 1 & 2)

3) Re CheckCompatibility, I still get the Excel Window Pop up everytime the new sheet is copied to a new book and I keep pressing "To Continue" button before saving

I've tried to download to my excel as Add In - Disable the CheckCompatibility but the message still poping up. Do you know if there is a way I can disable CheckCompatibility for good ?

Thank you and kind Regards,
Stel

markmzz · Jun 7, 2011

Re: MACRO to save worksheets as seperate files ?

Stelmarkov

Try this:

Code:

Sub CreateWorkbooks()
'Author: Dank
'Minor modifications: Markmzz
'Creates an individual workbook for each chose worksheet in the active workbook.
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim ws As Object
    Dim strSavePath As String
    Dim i As Integer
 
    On Error GoTo ErrorHandler
 
    Application.ScreenUpdating = False 'Don't show any screen movement
    strSavePath = ThisWorkbook.Path & "\" 'Change this to suit your needs
    Set wbSource = ActiveWorkbook
    For Each ws In wbSource.Sheets(Array(1, 2))
            ws.Copy
            Set wbDest = ActiveWorkbook
            wbDest.SaveAs Filename:=strSavePath & ws.Name & " " & _
                Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yy") & ".xls", _
                FileFormat:=xlExcel8
            'Question 02
            Cells.Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            Range("A1").Select
            'Question 03
            wbDest.Saved = False
            wbDest.CheckCompatibility = False
            wbDest.Close SaveChanges:=True 'Remove this if you don't want each book closed after saving.
    Next ws
    i = 1
    'Question 01
    For Each ws In wbSource.Sheets(Array(3, 4, 6, 7))
        If i = 1 Then
            ws.Copy
            Set wbDest = ActiveWorkbook
            wbDest.SaveAs Filename:=strSavePath & ws.Name & " " & _
                Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yy") & ".xls", _
                FileFormat:=xlExcel8
         Else
            ws.Copy Before:=wbDest.Sheets(1)
        End If
        'Question 02
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("A1").Select
        i = i + 1
    Next ws
    'Question 03
    wbDest.Saved = False
    wbDest.CheckCompatibility = False
    wbDest.Close SaveChanges:=True 'Remove this if you don't want each book closed after saving.
    Application.ScreenUpdating = True
 
    Set wbSource = Nothing
    Set wbDest = Nothing
    Exit Sub
 
ErrorHandler:     'Just in case something hideous happens
    MsgBox "An error has occurred. Error number=" & Err.Number & _
        ". Error description=" & Err.Description & "."
    Set wbSource = Nothing
    Set wbDest = Nothing
End Sub

Markmzz

stelmarkov · Jun 7, 2011

Re: MACRO to save worksheets as seperate files ?

Hello,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com

ffice

ffice" /><o

></o

>
Regarding my previously asked Q1,.....the below statement saves all 4 sheets together <o

></o

>
<o

></o

>
"For Each ws In wbSource.Sheets(Array(3, 4, 6, 7)) (saves all 4 selected sheets)"<o

></o

>
However I need to save<o

></o

>
<o

></o

>
sheets 3 & 4 as a separate file <o

></o

>
<o

></o

>
and then sheets 6 & 7 as a separate file <o

></o

>
<o

></o

>
Very sorry for the confusion <o

></o

>
<o

></o

>
Thanks & Regards,<o

></o