VBA: export sheets as Worksheets dynamically

Hello experts,

I use the following script to export worksheets reported in a Config Sheet to export dynamically  every sheet from my ActiveWorkbook:

Sub sheetexport()

Dim wb As Workbook
Dim ws As Worksheet, ws1 As Worksheet
Dim c As Range

Set wb = ThisWorkbook

wb.Sheets("Config-export").Activate

confirmation = MsgBox("Files reported in Config-Export will be exported. Are you sure that you want to export files reported", vbYesNo)

    If confirmation = vbNo Then Exit Sub

For Each c In Range(Range("A2"), Range("A" & Cells.Rows.Count).End(xlUp))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    ' Check If Directory is valid
    On Error Resume Next
    Directory = c.Offset(0, 1).Value
    On Error GoTo 0
    If Directory = 0 Or Directory = "" Then
        MsgBox "Path: " & c.Offset(0, 1).Value & " Is not valid"
    wb.Sheets("Config-export").Activate
        Exit Sub
    ' Check if Directory finish with a \
     If InStr(Right(Directory, 1), "\") > 0 Then
        MsgBox "Path: " & c.Offset(0, 1).Value & " Is not valid as it doesn't finish with \"
    wb.Sheets("Config-export").Activate
        Exit Sub
    End If
    End If
    
    ' Check if Sheet is valid
    On Error Resume Next
     Set ws = wb.Sheets(c.Offset(0, 0).Value)
     On Error GoTo 0
     If IsEmpty(ws) Or ws Is Nothing Then
    MsgBox "Worksheet: " & ws.Name & " is not valid"
    wb.Sheets("Config-export").Activate
    Exit Sub
    End If
         ws.Copy
         ActiveWorkbook.SaveAs Filename:=Directory & ActiveSheet.Name & ".xls", FileFormat:=51, CreateBackup:=False, Local:=True
         ActiveWorkbook.Close False

Application.ScreenUpdating = True

MsgBox ("File: " & ws.Name & " has been exported at :" & Directory)

Next
End Sub

Open in new window


I don't know why:

1-I am  not able to exit sub when one of the path reported doesn't finish with a "\"
2-When one of the Sheets reported doesn't exist I am not able to display the error message.
3-When I open one of the xls files generated I got the message "The file you are trying to open, is in a different format than the specified by the file extension". However when I click yes to confirm I have all the information.

Thank you again for your help.
LVL 1
LD16Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Change line 20 to

If Right(Directory, 1) <> "\" Then

Change line 40 to

If ws = "" Or ws Is Nothing Then
Martin LissOlder than dirtCommented:
It would help if you would attach your project.
LD16Author Commented:
Please find attached my project.

Thank you again for your help.
Export-workbooks-dynamically.xlsm
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Martin LissOlder than dirtCommented:
Should the workbooks you create have 1 sheet per workbook or should all of them have all the valid sheets named on the Config-export sheet?
LD16Author Commented:
1 Sheet per workbook. However if it doesn't take you a lot of time and it doesn't bother I am also interesting to see the code "of all of them have all the valid sheets named on the Config-export sheet" :-)
Martin LissOlder than dirtCommented:
Try the attached workbook which does one sheet per new workbook.
28695291.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Martin LissOlder than dirtCommented:
If you have any questions about the code then please ask.
LD16Author Commented:
Hello Martin,

Thank you very much for this solution. I really appreciate the comment and code optimisation.
I have a question. I was wondering why the directory verification when it doesn't exist hasn't been added?

I have added line (27). I prefer exit the sub if the user enter an invalid path instead of having a default error message from Excel.

Please let me know if there is a best way to check if path exist.

Sub sheetexport()

Dim wb As Workbook
Dim ws As Worksheet, ws1 As Worksheet
Dim c As Range
Dim Directory As String
Dim bExists As Boolean

Set wb = ThisWorkbook

wb.Sheets("Config-export").Activate

If MsgBox("Files reported in Config-Export will be exported. Are you sure that you want to export files reported", vbYesNo) = vbNo Then
    Exit Sub
End If
    
For Each c In Range(Range("A2"), Range("A" & Cells.Rows.Count).End(xlUp))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If c.Offset(0, 1).Value = "" Then
    MsgBox "Path may not be blank"
    Exit Sub
End If

If Len(Dir(c.Offset(0, 1).Value, vbDirectory)) = 0 Then
    MsgBox "Path: " & c.Offset(0, 1).Value & " is not valid"
    Exit Sub
End If

' If the user forgot the ending backslash, add it.
If Right(c.Offset(0, 1).Value, 1) <> "\" Then
    Directory = c.Offset(0, 1).Value & "\"
Else
    Directory = c.Offset(0, 1).Value
End If

bExists = False
For Each ws1 In Worksheets
    If ws1.Name = c.Value Then
        bExists = True
        Set ws = Sheets(c.Value)
        Exit For
    End If
Next
If Not bExists Then
    MsgBox "Worksheet: '" & c.Value & "' is not valid"
    Exit Sub
End If

ws.Copy
ActiveWorkbook.SaveAs Filename:=Directory & ActiveSheet.Name & ".xls", FileFormat:=56, CreateBackup:=False, Local:=True

ActiveWorkbook.Close False

Application.ScreenUpdating = True

MsgBox ("File: " & ws.Name & " has been exported at :" & Directory)

Next
End Sub

Open in new window

Martin LissOlder than dirtCommented:
That's a good way of finding out if the path exists, and since that's what you are doing rather than checking if it's valid, I would change line 28 to

MsgBox "Path: '" & c.Offset(0, 1).Value & "' does not exist"

Note the single quotes I added so as to better set off the offending value.

In any case you're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015
LD16Author Commented:
Thank you very much for your help!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.