C
CTB
MS Office Excel 2007
Hello all,
I have 5 huge workbooks each with 12 sheets of monthly data (sheet
names are in the format of "mmm yyyy"). I'm trying to split them up
into 12 not-as-huge single-sheet workbooks.
When I use "Worksheet.SaveAs" (see code pasted at the end), all 12
sheets are saved in the new workbook with the desired name...not just
the desired sheet.
How do I create 12 single-sheet workbooks from 1 12-sheet workbook?
Do I need to copy/move sheet to new workbook and save new workbook
with desired name?
Thanks for any help anyone can provide,
CTB
******** Code: ********
Option Explicit
Sub SplitSheets()
Dim pfso As New FileSystemObject
Dim pfsoSourceFolder As Folder
Dim pfsoDestFolder As Folder
Dim pstrDestFolder As String
Dim pfsoFile As File
Dim pwkbSource As Workbook
Dim pwksSource As Worksheet
Dim pstrDate As String
Dim pdteDate As Date
Dim pstrDestFileName As String
pstrDestFolder = "New Folder"
Set pfsoFile = pfso.GetFile(Application.GetOpenFilename)
Set pfsoSourceFolder = pfsoFile.ParentFolder
Set pfsoDestFolder = pfso.GetFolder(pfsoSourceFolder.Path &
Application.PathSeparator & pstrDestFolder)
For Each pfsoFile In pfsoSourceFolder.Files
Set pwkbSource = Application.Workbooks.Open(pfsoFile.Path, ,
True)
For Each pwksSource In pwkbSource.Worksheets
'pwksSource.Activate
pstrDate = pwksSource.Name
pdteDate = DateValue(pstrDate)
pdteDate = DateSerial(Year(pdteDate), Month(pdteDate) + 1,
0)
pstrDate = Format(pdteDate, "yyyy-mm-dd")
pstrDestFileName = pfsoDestFolder.Path &
Application.PathSeparator & pstrDate
'pstrDestFileName = pfsoDestFolder.Path &
Application.PathSeparator & pstrDate & ".xlsx"
pwksSource.SaveAs pstrDestFileName, xlOpenXMLWorkbook
Next pwksSource
pwkbSource.Close False
Next pfsoFile
End Sub
Hello all,
I have 5 huge workbooks each with 12 sheets of monthly data (sheet
names are in the format of "mmm yyyy"). I'm trying to split them up
into 12 not-as-huge single-sheet workbooks.
When I use "Worksheet.SaveAs" (see code pasted at the end), all 12
sheets are saved in the new workbook with the desired name...not just
the desired sheet.
How do I create 12 single-sheet workbooks from 1 12-sheet workbook?
Do I need to copy/move sheet to new workbook and save new workbook
with desired name?
Thanks for any help anyone can provide,
CTB
******** Code: ********
Option Explicit
Sub SplitSheets()
Dim pfso As New FileSystemObject
Dim pfsoSourceFolder As Folder
Dim pfsoDestFolder As Folder
Dim pstrDestFolder As String
Dim pfsoFile As File
Dim pwkbSource As Workbook
Dim pwksSource As Worksheet
Dim pstrDate As String
Dim pdteDate As Date
Dim pstrDestFileName As String
pstrDestFolder = "New Folder"
Set pfsoFile = pfso.GetFile(Application.GetOpenFilename)
Set pfsoSourceFolder = pfsoFile.ParentFolder
Set pfsoDestFolder = pfso.GetFolder(pfsoSourceFolder.Path &
Application.PathSeparator & pstrDestFolder)
For Each pfsoFile In pfsoSourceFolder.Files
Set pwkbSource = Application.Workbooks.Open(pfsoFile.Path, ,
True)
For Each pwksSource In pwkbSource.Worksheets
'pwksSource.Activate
pstrDate = pwksSource.Name
pdteDate = DateValue(pstrDate)
pdteDate = DateSerial(Year(pdteDate), Month(pdteDate) + 1,
0)
pstrDate = Format(pdteDate, "yyyy-mm-dd")
pstrDestFileName = pfsoDestFolder.Path &
Application.PathSeparator & pstrDate
'pstrDestFileName = pfsoDestFolder.Path &
Application.PathSeparator & pstrDate & ".xlsx"
pwksSource.SaveAs pstrDestFileName, xlOpenXMLWorkbook
Next pwksSource
pwkbSource.Close False
Next pfsoFile
End Sub