Below is some sample code that does something similar to what you are trying
to do. As I do not have any information regarding the names of the
worksheets, I did not attempt to rename the worksheets in the new workbook
after they are copied.
Function CreateWorkbooks()
Dim sFilename As String
Dim wkbTarget As Workbook
Dim wkbDestination As Workbook
Dim iNumOfSheets As Integer
Dim iSheetsInNewWorkbook
Dim i As Integer
Const FILE_DIR = "H:\Test1\"
'Grab the value of the SheetsInNewWorkbook property
iSheetsInNewWorkbook = Application.SheetsInNewWorkbook
'Temporarily reset the property so only one sheet is created in new
workbooks
Application.SheetsInNewWorkbook = 1
'Get the number of worksheets from one of the workbooks, assuming all
have the same number
sFilename = Dir(FILE_DIR & "*.xls")
Set wkbTarget = Workbooks.Open(FILE_DIR & sFilename)
iNumOfSheets = wkbTarget.Worksheets.Count
wkbTarget.Close
'Now we know the sheet count, loop and create the workbooks
For i = 1 To iNumOfSheets
'Create a new workbook to hold the copied sheets
Set wkbDestination = Workbooks.Add
'Get the first .xls file
sFilename = Dir(FILE_DIR & "*.xls")
'The sfilename variable will = "" when all .xls files in the folder
have been iterated
Do While sFilename <> ""
'Open the source workbook to copy the sheet, for first sheet
file is already open
Set wkbTarget = Workbooks.Open(FILE_DIR & sFilename)
'Copy the source worksheet to the new workbook, assume sheet
name is SheetX
wkbTarget.Worksheets("Sheet" & CStr(i)).Copy
wkbDestination.Worksheets("Sheet1")
'Close the source workbook without saving
wkbTarget.Close False
'Get the next filename
sFilename = Dir
Loop
'Remove default worksheet Sheet1
Application.DisplayAlerts = False
wkbDestination.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
'Save the workbook in a subdirectory "NewBooks"
wkbDestination.SaveAs FILE_DIR & "NewBooks\Sheet" & CStr(i) & ".xls"
'Close the workbook
wkbDestination.Close False
Next i
'Reset the SheetInNewWorkbook value back to its previous value
Application.SheetsInNewWorkbook = iSheetsInNewWorkbook
Set wkbTarget = Nothing
Set wkbDestination = Nothing
End Function
--
David Lloyd
MCSD .NET
http://LemingtonConsulting.com
This response is supplied "as is" without any representations or warranties.
Please help. Is too difficult for my Excel knowledge.
I have several excel files that have the same number of sheets (same
name same sequence).
I need to write a macro that loops through them , takes a first sheet
from each of the excel files and copy them into a new file, then takes
a second sheet from each file and does the same.
For example lets say I have File1.xls, File2.xls,File3.xls.
Each of them consists of Sheet1, Sheet2, Sheet3, Sheet4 and Sheet5.
After this macro runs it should create 5 files - Sheet1.xls,
Sheet2.xls, Sheet3.xls, Sheet4.xls, Sheet5.xls each of them containing
3 sheets - one from each of the original files.
Thank you!
