asked on

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.

Martin Liss

Change line 20 to

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

Change line 40 to

If ws = "" Or ws Is Nothing Then

Martin Liss

It would help if you would attach your project.

Luis Diaz

ASKER

Please find attached my project.

Thank you again for your help.
Export-workbooks-dynamically.xlsm

Martin Liss

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?

Luis Diaz

ASKER

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" :-)

ASKER CERTIFIED SOLUTION

Martin Liss

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Martin Liss

If you have any questions about the code then please ask.

Luis Diaz

ASKER

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 Liss

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

Luis Diaz

ASKER

Thank you very much for your help!