Using VBA, how does one save 6 Excel sheets to to 6 different folders?

Question

E.g., there are 6 sheets in a workbook. The sheets are named "Section 1", "Section 2", "Section 3", "Section 4", "Section 5", and "Section 6". Save those 6 sheets as separate files in their corresponding folders named "Section 1", "Section 2", "Section 3", "Section 4", "Section 5", and "Section 6". Said another way, how do I save an array of sheets as separate files into an array of folders.

I've tried:

Select Case x
        Case x = 1
        sec1fol = "\Section 1 Jobs Released Last Week (excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec1fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 2
        sec2fol = "\Section 2 Jobs Created Last Week (excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec2fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 3
        sec3fol = "\Section 3 Late Jobs"
            ActiveWorkbook.SaveAs Filename:=fName & sec3fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 4
        sec4fol = "Section 4 Unnegotiated Jobs"
            ActiveWorkbook.SaveAs Filename:=fName & sec4fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 5
        sec5fol = "\Section 5 Jobs To Go (Excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec5fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
  End Select

And

With Sheets(1)
 sec1fol = "Section 1 Jobs Released Last Week (excludes NRT Jobs)"
    ActiveWorkbook.SaveAs Filename:=fName & sec1fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(2)
 sec2fol = "Section 2 Jobs Created Last Week (excludes NRT Jobs)"
    ActiveWorkbook.SaveAs Filename:=fName & sec2fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(3)
 sec3fol = "Section 3 Late Jobs"
    ActiveWorkbook.SaveAs Filename:=fName & sec3fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(4)
 sec4fol = "Section 4 Unnegotiated Jobs"
    ActiveWorkbook.SaveAs Filename:=fName & sec4fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(5)
 sec5fol = "Section 5 Jobs To Go (Excludes NRT Jobs)"
    ActiveWorkbook.SaveAs Filename:=fName & sec5fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(6)
 sec6fol = "Section 6 Jobs To Go (NRT Jobs)"
    ActiveWorkbook.SaveAs Filename:=fName & sec6fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

This code partially works, but only with the first sheet and then it stops.

Sub SaveWS_to_file()

Dim x As Integer, Name As String, Name2 As String, Name3 As String, fName As String, DateString As String, _
sec1fol As String, sec2fol As String, sec3fol As String, sec4fol As String, sec5fol As String, sec6fol As String

On Error GoTo Error_Handler
For x = 1 To Sheets.Count

Name = "\\MARNV006\BM\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\"
Name = Name & "EDW Crystal Reports (Automation)\Test files\Section "
Name = Name & x & ".xls"
Sheets("Section " & x).Copy
ChDir "\\MARNV006\BM\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\EDW Crystal Reports (Automation)\Test files"

Name2 = "\\insitefs\www\htdocs\c130\comm\metrics\blue\deck_reports\"
Name2 = Name2 & "Section " & x & ".xls"
Sheets("Section " & x).Copy
ChDir "\\insitefs\www\htdocs\c130\comm\metrics\blue\deck_reports\"

fName = "\\marnv006\Bm\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\Blue Deck\Blue Deck "
fName = fName & Year(Date)
DateString = Format(Date, "mm-dd-yyyy")

'Deletes file if it already exists

On Error GoTo Error_Handler

ActiveWorkbook.SaveAs Filename:=Name, _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.SaveAs Filename:=Name2, _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False

With Sheets(x)
Select Case x
        Case x = 1
        sec1fol = "\Section 1 Jobs Released Last Week (excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec1fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 2
        sec2fol = "\Section 2 Jobs Created Last Week (excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec2fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 3
        sec3fol = "\Section 3 Late Jobs"
            ActiveWorkbook.SaveAs Filename:=fName & sec3fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 4
        sec4fol = "Section 4 Unnegotiated Jobs"
            ActiveWorkbook.SaveAs Filename:=fName & sec4fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 5
        sec5fol = "\Section 5 Jobs To Go (Excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec5fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
  End Select
  End With
'Deletes file if it already exists

On Error GoTo Error_Handler

ActiveWindow.Close
Next x

Exit_Procedure:
Exit Sub

Error_Handler:

    MsgBox "An error has occurred in this application. " _
    & "Please contact your technical support person and " _
    & "tell them this information:" _
    & vbCrLf & vbCrLf & "Error Number " & Err.Number & ", " _
    & Err.Description, _
    Buttons:=vbCritical, Title:="DMT Error"
    Resume Exit_Procedure
    Resume

Error [(errornumber)]
End Sub

What's you filepath up to the folder containing the folders "Section 1", "Section 2" etc? have you tried anything? — Jeremy, Dec 15 '16 at 13:14
Can you show what code you do have and what your filepath is — Jeremy, Dec 15 '16 at 13:36
You might need to check your usage of With...you aren't really utilizing it at all the way you have it. https://msdn.microsoft.com/en-us/library/wc500chb.aspx — Rdster, Dec 15 '16 at 14:28
I've edited to add a partially working version, but it only works with the first sheet and then it stops. — Adavid02, Dec 15 '16 at 14:35
Is this a different question than http://stackoverflow.com/questions/41125953/excel-vba-save-sheets-to-multiple-folders-with-unique-names which you asked yesterday? — David Zemens, Dec 15 '16 at 14:39
Can you explain how it is different? Because at first glance, it looks nearly identical, and I'm inclined to close it as a duplicate. — David Zemens, Dec 15 '16 at 14:44
No, please explain how it differs in a significant way. The problem appears to be identical one, and the code is very similar: attempting to map worksheets to a specific path for a `SaveAs` operation. — David Zemens, Dec 15 '16 at 14:47
"a duplicate... This question has been asked before and already has an answer." I.e. this does not meet that criteria — Adavid02, Dec 15 '16 at 14:47
You might also care to explain what you mean by "then it stops", and specifically include detail description of what happens when you step through your code line by line. That will point you towards a specific, solvable problem about 95% of the time. Do you know how to step through the code? — David Zemens, Dec 15 '16 at 14:48
f8, I've been stepping all morning. Thank you for the suggestion. — Adavid02, Dec 15 '16 at 14:51
Odd, I'm testing with the "With Sheets" method and it appears to be working, i.e., the file is being saved to the correct folder BUT I am getting a "file exists error. do I want to replace it" which makes me think the process is duplicating? — Adavid02, Dec 15 '16 at 14:59
@Adavid02 since this Q has been closed, I would encourage you to revise your previous (similar) question. Include the code you're currently using, and that specific description of the point of failure. I'm adding an answer to your other question now, there are a number of issues (or potential issues) that I see in the original code, that may need to be addressed, first. — David Zemens, Dec 15 '16 at 15:08

score -1 · Answer 1 · answered Dec 15 '16 at 13:16

-1

Have you looked at: So, I have 6 "master" files to then divide into 40 separate files ? I needed to do exactly what you describe in your question.

answered Dec 15 '16 at 13:16

Solar Mike

7,156
4
17
32

I will check it out now. Thanks! – Adavid02 Dec 15 '16 at 13:18
ok, I only needed them in one place, but you can edit the path... – Solar Mike Dec 15 '16 at 13:20
I need each sheet in a different folder, but I am going through your method now to see if I can adjust to use it. – Adavid02 Dec 15 '16 at 13:34
@SolarMike I feel like this should've been a *comment* and not an answer. If you feel it's similar enough, then vote to close as Duplicate. – David Zemens Dec 15 '16 at 14:37
@David Zemens I gave a sensible response that showed a method of doing what he needed - albeit without changing path, but that can be included. Why do you think that it is inappropriate? – Solar Mike Dec 15 '16 at 14:52
Link-only answers are frowned upon, even if the link is to another SO question. A Dupe vote would've been more appropriate if the question can be "answered" simply by linking to the existing question. Otherwise, if you don't have time to write an actual answer, you could leave a comment suggesting OP refer to the other solution. – David Zemens Dec 15 '16 at 14:56
@David Zemens So what do the words "Have you looked at:" mean? Also, I understood that this is not a code-writing service, so your suggestion about "write an actual answer" is curious and, since I provided the link AND the OP has said he will look at it then, surely I have posted something useful. – Solar Mike Dec 15 '16 at 15:29
I gave three good reasons why this is either not really an answer (i.e., it's actually a *comment*), or not a *good* answer for StackOverflow. You're correct, this is not a "code-writing service" but OP provided the code, not ask you to "write" it, only to help troubleshoot it and suggest possible solution(s). If you look at almost any accepted answer on this site, you'll find that the answerer has "written" (more likely: revised or fixed) the OP's code. – David Zemens Dec 15 '16 at 15:38
Further: A low-quality answer, or even an answer that *should've* been a comment, can still be "useful" to the OP. (Note that it would've been *just as useful* if left as a *comment*, instead) – David Zemens Dec 15 '16 at 15:40
If you checked you would have noted that my first reply was before he edited and provided his code... And the word "answerer" if you wish to mention quality? Responder would be better. – Solar Mike Dec 15 '16 at 15:47

Using VBA, how does one save 6 Excel sheets to to 6 different folders?

1 Answers1