M
michael.beckinsale
Hi All,
The following code snippet is invoked from my personal.xls workbook.
What l am attempting to do is select any excel file in any directory
and then create a .xls file for each worksheet in the selected
workbook into a 'TEMP' directrory
The code is failing at the 'sh.Copy' line. Can anybody tell me what is
wrong please?
FileNameOnly & DirOnly are simply functions that l have used many
times to extract the relevant information from the string returned by
GetOpenFilename
Additionally l need to add some code to check if the 'TEMP' directory
has already exists, any ideas, example code would be gratefully
appreciated.
Sub CreateXLFiles()
Dim afile As String 'Source workbook to be rebuilt
Dim adir As String 'Directory of sheet files
Dim sh As Worksheet
afile = Application.GetOpenFilename(, , "Select the source
file", , False)
Application.ScreenUpdating = False
adir = (DirOnly(afile) & "\" & FileNameOnly(afile) & "-TEMP")
MkDir adir
Workbooks.Open afile, UpdateLinks:=False
For Each sh In Workbooks(FileNameOnly(afile)).Worksheets
sh.Copy <<<<<<<<<<<<<<<ERROR HERE
ActiveWorkbook.SaveAs adir & ActiveSheet.Name & ".xls"
ActiveWorkbook.Close SaveChanges:=False
Next
Workbooks(FileNameOnly(afile)).Close SaveChanges:=False
End Sub
Regards
Michael
The following code snippet is invoked from my personal.xls workbook.
What l am attempting to do is select any excel file in any directory
and then create a .xls file for each worksheet in the selected
workbook into a 'TEMP' directrory
The code is failing at the 'sh.Copy' line. Can anybody tell me what is
wrong please?
FileNameOnly & DirOnly are simply functions that l have used many
times to extract the relevant information from the string returned by
GetOpenFilename
Additionally l need to add some code to check if the 'TEMP' directory
has already exists, any ideas, example code would be gratefully
appreciated.
Sub CreateXLFiles()
Dim afile As String 'Source workbook to be rebuilt
Dim adir As String 'Directory of sheet files
Dim sh As Worksheet
afile = Application.GetOpenFilename(, , "Select the source
file", , False)
Application.ScreenUpdating = False
adir = (DirOnly(afile) & "\" & FileNameOnly(afile) & "-TEMP")
MkDir adir
Workbooks.Open afile, UpdateLinks:=False
For Each sh In Workbooks(FileNameOnly(afile)).Worksheets
sh.Copy <<<<<<<<<<<<<<<ERROR HERE
ActiveWorkbook.SaveAs adir & ActiveSheet.Name & ".xls"
ActiveWorkbook.Close SaveChanges:=False
Next
Workbooks(FileNameOnly(afile)).Close SaveChanges:=False
End Sub
Regards
Michael