RE: MACRO to save worksheets as seperate files ?

[stelmarkov]

RE: MACRO to save worksheets as seperate files ?

Hello, <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><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

 

[markmzz]

Re: Thank you!!! MACRO to save worksheets as seperate files ?

Hello!<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
A VERY VERY BIG FAT THANK YOU FOR YOUR HELP!!!
<o></o>
This is my first time on any block and I never knew that I can ask for help on the net. Thank you for sharing your knowledge and showing me macro codes. They all work perfectly and importantly saving over 300 sheets takes me now few minutes and not days !!!.
I will defiantly study them so I can understand them better.

<o></o>
<o></o>
<o></o>
Until Next Time <o></o>
<o></o>
Kind Regards,<o></o>
Stel<o></o>

Stelmarkov,

Thanks for the feedback.

Note: to help understand the use of macro in Excel, try the easy book Excel 2007 Visual Basic for Applications – Step by Step.

Markmzz

 

[nikegeo]

Re: MACRO to save worksheets as seperate files ?

Hi Guys,

i posted a similar question earlier today before stumbling upon this thread. I ran the macro however it was not what I was looking for. I'm hoping you can help me with a similar solution for:

I have a Spreadsheet with 30 tabs - i'd like to extract 25 of those 30 into their own worksheets with the name of the new files being named after the sheet name (if this complicates things then extracting each sheet into its own file is fine - i can delete the others i dont need). In addition i'd like the new files to be pasted as value and number formats as the original large file has ranges and each sheet references data from a raw data worksheet.

The current files have print ranges if that makes things easier to copy that range into a new worksheet. Every worksheet has a unique name (i.e. Brazil, USA, South Africa, China, etc..) and i would like the sheets saved into the same directory as the original file.

 

[markmzz]

Re: MACRO to save worksheets as seperate files ?

Nikegeo,

I need more information.

Could you put same examples.

Markmzz

 

[nikegeo]

Re: MACRO to save worksheets as seperate files ?

Hey markmzz - so i have a spreadsheet with 29 worksheets each with different info that is calculated from a data work sheet. I would like to extract 25 of these sheets into their own excel files - xlsx format - im using excel 2010.

when i run the macro in this post it gives me the compatibility pop-up for converting from xlsx to xls along with the following warning:

Defined names or formulas in this workbook may display different values when they are recalculated in an earlier version of excel ...etc...

-- removed inline image ---
(sorry tried to paste a screen shot)


I also don't know where it saves the new excel files to.

I would like the Macro to perform the following:
1. copy the worksheets 5-30 (in that order) or the last 25 sheets in the workbook, excluding the hidden worksheets into new individual workbooks
2. paste special > Number and Value format to remove all formulas and range reference
3. Save the extracted worksheets to new workbooks named after the sheet names (sheet names are countries and regions we track -i.e. Spain, UK, Italy, South Africa, etc...)
4. Save the new worksheets in the same folder as the original workbook
5. Leave the original file intact

Please let me know if additional information is required...

In addition - the original Dank macro works to save each worksheet in its own excel named after the sheet however the formulas are still in the cells (not copy and pasted as value and number formats)

 

[markmzz]

Re: MACRO to save worksheets as seperate files ?

Nikegeo,


I send to you a private message.


Markmzz

 

[markmzz]

Re: MACRO to save worksheets as seperate files ?

Nikegeo,

Try this:

Important: Make a copy of your Workbook first.

[COLOR=blue]Sub CreateWorkbooks25()[/COLOR]
[COLOR=blue]'Author: Dank[/COLOR]
[COLOR=blue]'Modifications: Markmzz[/COLOR]
[COLOR=blue]'Creates an individual workbook for each chose worksheet in the active workbook.[/COLOR]
[COLOR=blue]   Dim wbDest As Workbook[/COLOR]
[COLOR=blue]   Dim wbSource As Workbook[/COLOR]
[COLOR=blue]   Dim ws As Object[/COLOR]
[COLOR=blue]   Dim strSavePath As String[/COLOR]
[COLOR=blue]   Dim i, j As Integer[/COLOR]
[COLOR=blue]   Dim myRange As Range[/COLOR]
 
[COLOR=blue]   On Error GoTo ErrorHandler[/COLOR]
 
[COLOR=blue]   Application.ScreenUpdating = False[/COLOR]
 
[COLOR=blue]   strSavePath = ThisWorkbook.Path & "\"[/COLOR]
[COLOR=blue]   Set wbSource = ActiveWorkbook[/COLOR]
 
[COLOR=blue]   For i = 6 To 30[/COLOR]
[COLOR=blue]       Set ws = Worksheets(i)[/COLOR]
[COLOR=blue]       ws.Copy[/COLOR]
[COLOR=blue]       Set wbDest = ActiveWorkbook[/COLOR]
[COLOR=blue]       wbDest.SaveAs Filename:=strSavePath & ws.Name[/COLOR]
[COLOR=blue]       Set myRange = ActiveSheet.UsedRange[/COLOR]
[COLOR=blue]       myRange.Copy[/COLOR]
[COLOR=blue]       myRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats[/COLOR]
[COLOR=blue]       Application.CutCopyMode = False[/COLOR]
[COLOR=blue]       Range("A1").Select[/COLOR]
[COLOR=blue]       wbDest.Close SaveChanges:=True[/COLOR]
[COLOR=blue]   Next i[/COLOR]
 
[COLOR=blue]   Application.ScreenUpdating = True[/COLOR]
 
[COLOR=blue]   Set wbSource = Nothing[/COLOR]
[COLOR=blue]   Set wbDest = Nothing[/COLOR]
[COLOR=blue]   Exit Sub[/COLOR]
 
[COLOR=blue]ErrorHandler:[/COLOR]
[COLOR=blue]   MsgBox "An error has occurred. Error number=" & Err.Number & _[/COLOR]
[COLOR=blue]       ". Error description=" & Err.Description & "."[/COLOR]
[COLOR=blue]   Set wbSource = Nothing[/COLOR]
[COLOR=blue]   Set wbDest = Nothing[/COLOR]
[COLOR=blue]End Sub[/COLOR]

Markmzz

 

[nikegeo]

Re: MACRO to save worksheets as seperate files ?

tried to run the VBA and received the following error

An error has occured. Error number=1004. Error description=Copy method of worksheet class failed.

leaving the office now but will be back on tomorrow morning. Thanks for the help Markmzz

 

[markmzz]

Re: MACRO to save worksheets as seperate files ?

tried to run the VBA and received the following error

An error has occured. Error number=1004. Error description=Copy method of worksheet class failed.

leaving the office now but will be back on tomorrow morning. Thanks for the help Markmzz

Ok. Give me more information tomorrow morning.

Note: I test it here many times and no problem.

Markmzz

 

[markmzz]

Re: MACRO to save worksheets as seperate files ?

Nikegeo,

This is the code with many commnets:

[COLOR=blue]Sub CreateWorkbooks25()[/COLOR]
[COLOR=blue]'[/COLOR]
[COLOR=blue]'Prg    : CreateWorkbooks25[/COLOR]
[COLOR=blue]'Author: Dank[/COLOR]
[COLOR=blue]'Modifications: Markmzz[/COLOR]
[COLOR=blue]'Date   : 10/06/2011[/COLOR]
[COLOR=blue]'Version: 01[/COLOR]
[COLOR=blue]'[/COLOR]
[COLOR=blue]'Creates an individual workbook for each worksheet (6 to 30) in the active[/COLOR]
[COLOR=blue]'workbook and save the 25 files in the same directory of the master workbook.[/COLOR]
[COLOR=blue]'[/COLOR]
[COLOR=blue]   'Sets the macro variables explicitly[/COLOR]
[COLOR=blue]   Dim wbDest As Workbook[/COLOR]
[COLOR=blue]   Dim wbSource As Workbook[/COLOR]
[COLOR=blue]   Dim ws As Object[/COLOR]
[COLOR=blue]   Dim strSavePath As String[/COLOR]
[COLOR=blue]   Dim i As Integer[/COLOR]
[COLOR=blue]   Dim myRange As Range[/COLOR]
 
[COLOR=blue]   'If a error occurs goto label ErrorHandler[/COLOR]
[COLOR=blue]   On Error GoTo ErrorHandler[/COLOR]
 
[COLOR=blue]   'Disable ScreenUpdating[/COLOR]
[COLOR=blue]   Application.ScreenUpdating = False[/COLOR]
 
[COLOR=blue]   'Store the path of the master workbook[/COLOR]
[COLOR=blue]   'in to the variable strSavePath[/COLOR]
[COLOR=blue]   strSavePath = ThisWorkbook.Path & "\"[/COLOR]
 
[COLOR=blue]   'Store the reference to the master workbook[/COLOR]
[COLOR=blue]   'in the variable wbSource[/COLOR]
[COLOR=blue]   Set wbSource = ActiveWorkbook[/COLOR]
 
[COLOR=blue]   'Navigates for the worksheets 6 to 30 in[/COLOR]
[COLOR=blue]   'the master workbook[/COLOR]
[COLOR=blue]   For i = 6 To 30[/COLOR]
[COLOR=blue]       'Srore the reference of the workbook(i) to the[/COLOR]
[COLOR=blue]       'variable ws[/COLOR]
[COLOR=blue]       Set ws = Worksheets(i)[/COLOR]
 
[COLOR=blue]       'Creates a new workbook that includes a copy of[/COLOR]
[COLOR=blue]       'the workbook(i)[/COLOR]
[COLOR=blue]       ws.Copy[/COLOR]
 
[COLOR=blue]       'Store the reference to the new workbook[/COLOR]
[COLOR=blue]       'in the variable wbDest[/COLOR]
[COLOR=blue]       Set wbDest = ActiveWorkbook[/COLOR]
 
[COLOR=blue]       'Saved the new workbook in the same path of[/COLOR]
[COLOR=blue]       'the master workbook and with the name of[/COLOR]
[COLOR=blue]       'the worksheet(i)[/COLOR]
[COLOR=blue]       wbDest.SaveAs Filename:=strSavePath & ws.Name[/COLOR]
 
[COLOR=blue]       'Selected the range os used cells of the current[/COLOR]
[COLOR=blue]       'worksheet in the new workbook[/COLOR]
[COLOR=blue]       Set myRange = ActiveSheet.UsedRange[/COLOR]
 
[COLOR=blue]       'Removed all formula and format of the current worksheet[/COLOR]
[COLOR=blue]       'in the new workbook[/COLOR]
[COLOR=blue]       myRange.Copy[/COLOR]
[COLOR=blue]       myRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats[/COLOR]
 
[COLOR=blue]       'Cancel the CutCopy Mode and remove the moving border[/COLOR]
[COLOR=blue]       'around the cells[/COLOR]
[COLOR=blue]       Application.CutCopyMode = False[/COLOR]
 
[COLOR=blue]       'Selected the cell A1 of the current worksheet[/COLOR]
[COLOR=blue]       'in the new workbook[/COLOR]
[COLOR=blue]       Range("A1").Select[/COLOR]
 
[COLOR=blue]       'Close and save the new workbook[/COLOR]
[COLOR=blue]       wbDest.Close SaveChanges:=True[/COLOR]
[COLOR=blue]   Next i[/COLOR]
 
[COLOR=blue]   'Enable screen updating[/COLOR]
[COLOR=blue]   Application.ScreenUpdating = True[/COLOR]
 
[COLOR=blue]   'Frees the memory used by the reference variables[/COLOR]
[COLOR=blue]   Set wbSource = Nothing[/COLOR]
[COLOR=blue]   Set wbDest = Nothing[/COLOR]
 
[COLOR=blue]   'Exit the macro before execute the error rotine[/COLOR]
[COLOR=blue]   Exit Sub[/COLOR]
 
[COLOR=blue]'Beginning of the error routine[/COLOR]
[COLOR=blue]ErrorHandler:[/COLOR]
[COLOR=blue]   MsgBox "An error has occurred. Error number=" & Err.Number & _[/COLOR]
[COLOR=blue]       ". Error description=" & Err.Description & "."[/COLOR]
 
[COLOR=blue]   'Frees the memory used by the reference variables[/COLOR]
[COLOR=blue]   Set wbSource = Nothing[/COLOR]
[COLOR=blue]   Set wbDest = Nothing[/COLOR]
[COLOR=blue]End Sub[/COLOR]

Note: I send to you my test workbook.

Markmzz

 

[nikegeo]

Re: MACRO to save worksheets as seperate files ?

Mark - thank you for your help! It work however the path that the workbooks were saved into are different from the folder that the original file was in. The macro saved the workbooks into:

C:\Documents and Settings\matt\Application Data\Microsoft\Excel\XLSTART

Could the fact that im on a company computer be affecting the path where excel defaults to?

thanks again!