VB Export tabs to specific folders

[jwmi01]

Following script exports specific tabs in the workbook to one folder (Manual Backups) on a network. Looking for a way to export each tab to its own specific folder.

i.e. worksheet "Apples" in the array saves to folder "Apples" etc. Any suggestions are appreciated!

Sub ExportWorksheetsToSpecificFolderTest()

    Dim worksheet_list As Variant, worksheet_name As Variant
    Dim new_workbook As Workbook
    Dim saved_folder As String
    
    worksheet_list = Array("Apples", "Oranges", "Bananas", "Grapes")
    '// close the path with a back slash
    saved_folder = "\\ABC-DC01\ABCComm\Common\District Data\Daily Report\Manual Backups\"
    
    For Each worksheet_name In worksheet_list
    
        On Error Resume Next
       
        Set new_workbook = Workbooks.Add
        
        ThisWorkbook.Worksheets(worksheet_name).Copy new_workbook.Worksheets(1)
        
        new_workbook.SaveAs saved_folder & worksheet_name & " " & Format(Now(), "MM-DD-YY") & ".csv", 6
        new_workbook.Close False
        
    Next worksheet_name
    
    MsgBox "Export complete.", vbInformation
End Sub

 

[Bosquedeguate]

I did not test this, but I think if you move the saved_folder = ... line inside your loop you will have a solution.

This code should

1. test for the existence of the backup folder for the Worksheet (path & folder_name)
2. if it does not exist, create it
3. save the new workbook to the folder from 1. or 2. above

Please try testing this (I gave it a quick test, but not for a network path) and let me know what happens. .

I couldn't determine what the worksheet_list array was for. It does not appear to be used.

Sub ExportWorksheetsToSpecificFolderTest()

    Dim worksheet_list As Variant, worksheet_name As Variant
    Dim new_workbook As Workbook
    Dim saved_path As String
    Dim saved_folder As String
    Dim fs 
    
    worksheet_list = Array("Apples", "Oranges", "Bananas", "Grapes")
    '// close the path with a back slash
    saved_path= "\\ABC-DC01\ABCComm\Common\District Data\Daily Report\Manual Backups\"
    
    For Each worksheet_name In worksheet_list

      saved_folder = saved_path & worksheet_name
      Set fs = CreateObject("Scripting.FileSystemObject")
      If fs.folderexists(saved_folder ) = False Then
          fs.createfolder saved_folder
      End If

    
        On Error Resume Next
       
        Set new_workbook = Workbooks.Add
        
        ThisWorkbook.Worksheets(worksheet_name).Copy new_workbook.Worksheets(1)
        
        new_workbook.SaveAs saved_folder & worksheet_name & " " & Format(Now(), "MM-DD-YY") & ".csv", 6
        new_workbook.Close False
        
    Next worksheet_name
    
    MsgBox "Export complete.", vbInformation
End Sub

 

[Bosquedeguate]

please change the line of code that defines "save_folder" (inside your loop) to:

saved_folder = saved_path & worksheet_name & "\"

 

[jwmi01]

Appreciate you taking a look.

Getting a 76 path not found error here

 

[Bosquedeguate]

You might put a msgbox in where above where the error occurs to verify the value of saved folder.

 

[Bosquedeguate]

Try this modification … and let me know.

Remove the & “\” that you added

And modify the .SaveAs line to
new_workbook.SaveAs saved_folder & “\” & worksheet_name & " " & Format(Now(), "MM-DD-YY") & ".csv", 6

 

[jwmi01]

Runs with no error and gives Export Complete msg but there's no output. changed path to a local folder with same result.

Not sure if this helps, but the Array is designating the specific sheets in the workbook to export. It has 10, but I only need 4 of those 10. I should have clarified that.

 

[Bosquedeguate]

this code worked on my NAS drive ...

Sub ExportWorksheetsToSpecificFolderTest()

    Dim worksheet_list As Variant, worksheet_name As Variant
    Dim new_workbook As Workbook
    Dim saved_path As String
    Dim saved_folder As String
    Dim fs
   
    worksheet_list = Array("Apples", "Oranges", "Bananas", "Grapes")
    '// close the path with a back slash
    saved_path = "\\ABC-DC01\ABCComm\Common\District Data\Daily Report\Manual Backups\"
   
    For Each worksheet_name In worksheet_list

      saved_folder = saved_path & worksheet_name
      Set fs = CreateObject("Scripting.FileSystemObject")
      If fs.folderexists(saved_folder) = False Then
          fs.createfolder saved_folder
      End If

   
        On Error Resume Next
      
        Set new_workbook = Workbooks.Add
       
        ThisWorkbook.Worksheets(worksheet_name).Copy new_workbook.Worksheets(1)
       
        new_workbook.SaveAs saved_folder & "\" & worksheet_name & " " & Format(Now(), "MM-DD-YY") & ".csv", 6
        new_workbook.Close False
       
    Next worksheet_name
   
    MsgBox "Export complete.", vbInformation
End Sub

 

[jwmi01]

You are 100% correct.....I wasn't adding the saved folder path under the "For Each worksheet_name" so it was saving to My Documents

Thanks so much for the assistance, I greatly appreciate your help!