Why doesn't this work?

[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

 

[tausif]

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

Hi - use the foll code to make sure a folder exists
Sub FolderExists()
Dim fso
Dim folder As String
folder = "C:\My Documents" ' change to match the folder path
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(folder) Then
MsgBox folder & " is a valid folder/path.", vbInformation, "Path
Exists"
Else
MsgBox folder & " is not a valid folder/path.", vbInformation,
"Invalid Path"
End If
End Sub

 

[Ron de Bruin]

Hi Michael

Difficult to see your problem without seeing all the code

Try to adapt this example
http://www.rondebruin.nl/copy6.htm

 

[ytayta555]

The code is failing at the 'sh.Copy' line. Can anybody tell me what is
wrong please?

Sub CreateXLFiles()

    Dim sh As Worksheet

        sh.Copy  <<<<<<<<<<<<<<<ERROR HERE
Michael

Maybe you Dim sh As Worksheet but forget to Set the sh :
Set sh = (your sheet) or Array(your sheets)

 

[michael.beckinsale]

Hi All,

Many thanks for all your input.

The problem was caused by a 'hidden' sheet in the workbook l was using
for testing.

I have revised the code to test for visibilty and now all is OK.

Tausif - thanks for the code which l have now incorporated.

As an aside the next step is to import the created sheets in to new
workbook, the problem l am having is keeping the order of the sheets
the same as the original. Additionally l would like to delete the
sheets of the new workbook ie typically Sheet1, Sheet2, Sheet3

As you might have gathered l am creating a 'REBUILD' utility to help
reduce workbook bloat.

Any ideas gratefully received

Regards

Michael

 

[Ron de Bruin]

Maybe this will help you a bit
But there are many things to check (links for example that are not pointing to the correct workbook anymore)

Jan Karel Pieterse built one also and I think you can beta test it
Send JKP a mail (I believe his is on vacation now)

Sub Test()
Dim wb1 As Workbook
Dim wb2 As Workbook

Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Add(1)
wb2.Sheets(1).Name = "qqqqqqqqqwwwwwwwww"
wb1.Sheets.Copy after:=wb2.Sheets(wb2.Sheets.Count)

Application.DisplayAlerts = False
wb2.Sheets(1).Delete
Application.DisplayAlerts = True

End Sub