Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

**Ppsych** · 01-22-2013, 02:33 PM

Greetings-
I am attempting to export selected sheets of a master workbook to either 1, 2, or 3 new workbooks, depending on the value of cell C27 (which will be 1, 2, or 3). The filename of each new workbook will also vary depending on C27’s value. I’m a near-total novice at VBA, but this is what I’ve come up with. When I run the code, I get the “else without if” error. I’ve tried many different variations of If, Else, and
ElseIf… so the error is probably occurring because I am going about this task in a fundamentally wrong way. I cannot upload the workbook in question due to the security restrictions at my workplace. I am sure there are much better ways to do what I am attempting, but I am at the limit of my knowledge of VBA. Any assistance in fixing the code would be greatly appreciated.

Sub Createtemplate2()
MsgBox "This function creates the template."
    Dim relativePath1 As String
    Dim relativePath2 As String
    Dim relativePath3 As String
    relativePath1 = ThisWorkbook.Path & "\" & "S # 1 Template " & Sheets("Welcome").Range("O26").Value & ".xlsm"
    relativePath2 = ThisWorkbook.Path & "\" & "S # 2 Template " & Sheets("Welcome").Range("O28").Value & ".xlsm"
    relativePath3 = ThisWorkbook.Path & "\" & "S # 3 Template " & Sheets("Welcome").Range("O30").Value & ".xlsm"
    
If Range("C27").Value = 1 Then
For Each ws In Worksheets(Array("General_Instructions", "Information", "Instructions", _
"Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments"))
    SheetName = ws.Name
    ws.Copy
    With ActiveWorkbook
    .SaveAs Filename:=relativePath1
    .Close SaveChanges:=True

ElseIf Range("C27").Value = 2 Then
For Each ws In Worksheets(Array("General_Instructions", "Information", "Instructions", _
"Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments"))
    SheetName = ws.Name
    ws.Copy
    With ActiveWorkbook
    .SaveAs Filename:=relativePath1
    .Close SaveChanges:=True
    .SaveAs Filename:=relativePath2
    .Close SaveChanges:=True

ElseIf Range("C27").Value = 3 Then
For Each ws In Worksheets(Array("General_Instructions", "Information", "Instructions", _
"Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments"))
    SheetName = ws.Name
    ws.Copy
    With ActiveWorkbook
    .SaveAs Filename:=relativePath1
    .Close SaveChanges:=True
    .SaveAs Filename:=relativePath2
    .Close SaveChanges:=True
    .SaveAs Filename:=relativePath3
    .Close SaveChanges:=True
    End If
End Sub

**xladept** · 01-22-2013, 02:40 PM

Hi Ppsych,

You have With.....End With without any End With's!

**Ppsych** · 01-22-2013, 02:46 PM

Thanks- I've added those in. Still getting the "else without if" error, though.

**xladept** · 01-22-2013, 04:03 PM

See if this runs:

Sub Createtemplate2(): Dim SheetName As String, ws As Worksheet
MsgBox "This function creates the template."
    Dim relativePath1 As String
    Dim relativePath2 As String
    Dim relativePath3 As String
    relativePath1 = ThisWorkbook.Path & "\" & "S # 1 Template " & Sheets("Welcome").Range("O26").Value & ".xlsm"
    relativePath2 = ThisWorkbook.Path & "\" & "S # 2 Template " & Sheets("Welcome").Range("O28").Value & ".xlsm"
    relativePath3 = ThisWorkbook.Path & "\" & "S # 3 Template " & Sheets("Welcome").Range("O30").Value & ".xlsm"
    
If Range("C27").Value = 1 Then
For Each ws In Worksheets(Array("General_Instructions", "Information", "Instructions", _
"Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments"))
    SheetName = ws.Name
    ws.Copy
    With ActiveWorkbook
    .SaveAs fileName:=relativePath1
    .Close SaveChanges:=True
End With: Next
ElseIf Range("C27").Value = 2 Then
For Each ws In Worksheets(Array("General_Instructions", "Information", "Instructions", _
"Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments"))
    SheetName = ws.Name
    ws.Copy
    With ActiveWorkbook
    .SaveAs fileName:=relativePath1
    .Close SaveChanges:=True
    .SaveAs fileName:=relativePath2
    .Close SaveChanges:=True
End With: Next
ElseIf Range("C27").Value = 3 Then
For Each ws In Worksheets(Array("General_Instructions", "Information", "Instructions", _
"Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments"))
    SheetName = ws.Name
    ws.Copy
    With ActiveWorkbook
    .SaveAs fileName:=relativePath1
    .Close SaveChanges:=True
    .SaveAs fileName:=relativePath2
    .Close SaveChanges:=True
    .SaveAs fileName:=relativePath3
    .Close SaveChanges:=True
    End With: Next
End If
End Sub

**Ppsych** · 01-22-2013, 04:42 PM

XLadept- it runs, but does not actually save any files. I'll take another look at the code for mistakes I've made and let you know if I find anything. I really appreciate the help!

**xladept** · 01-22-2013, 09:26 PM

Hi Ppsych,

Let me know if this works - I can't test it:

Sub Createtemplate2(): Dim SheetName As String, ws As Worksheet, wb As Workbook, W, i As Integer
MsgBox "This function creates the template."
    Dim relativePath1 As String
    Dim relativePath2 As String
    Dim relativePath3 As String
    W = Array(" ", "General_Instructions", "Information", "Instructions", _
        "Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments")
    relativePath1 = ThisWorkbook.Path & "\" & "S # 1 Template " & Sheets("Welcome").Range("O26").Value & ".xlsm"
    relativePath2 = ThisWorkbook.Path & "\" & "S # 2 Template " & Sheets("Welcome").Range("O28").Value & ".xlsm"
    relativePath3 = ThisWorkbook.Path & "\" & "S # 3 Template " & Sheets("Welcome").Range("O30").Value & ".xlsm"

    Set ws = ThisWorkbook.Worksheets(W(1))
    ws.Copy: Set wb = ActiveWorkbook
    For i = 2 To 9
    Set ws = ThisWorkbook.Worksheets(W(i))
    ws.Copy wb: Next i
If Range("C27").Value = 1 Then GoTo Save1
If Range("C27").Value = 2 Then GoTo Save2
If Range("C27").Value <> 3 Then Exit Sub
    wb.SaveAs FileName:=relativePath3
Save2:
    wb.SaveAs FileName:=relativePath2
Save1:
    wb.SaveAs FileName:=relativePath1
    wb.Close SaveChanges:=True
End Sub

**Ppsych** · 01-23-2013, 09:21 AM

That started to work- it created a new workbook (titled Book1), with one worksheet (“Instructions”). However, the code stalls out there- error 400. The same outcome occurs when C27 contains 1, 2, and 3. I’ve double-checked the sheet names, and they are all correct. The sheets are all unprotected. Subsequent attempts produce the same error, but the numbers associated with the file names increase (Book2, Book3, etc.) Is there something screwy in here, maybe?

 Set ws = ThisWorkbook.Worksheets(W(1))
    ws.Copy: Set wb = ActiveWorkbook
    For i = 2 To 9
    Set ws = ThisWorkbook.Worksheets(W(i))
    ws.Copy wb: Next i

**Ppsych** · 01-23-2013, 09:21 AM

accidental double-post (deleted).

**xladept** · 01-23-2013, 02:51 PM

Hi Ppsych,

Try this - I adapted some old code from my repertoire:

Sub Createtemplate2(): Dim ws As Worksheet, wb As Workbook, ss As Worksheet
Dim SheetName As String, W, i As Integer
MsgBox "This function creates the template."
    Dim relativePath1 As String
    Dim relativePath2 As String
    Dim relativePath3 As String
    W = Array(" ", "General_Instructions", "Information", "Instructions", _
        "Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments")
    relativePath1 = ThisWorkbook.Path & "\" & "S # 1 Template " & Sheets("Welcome").Range("O26").Value & ".xlsm"
    relativePath2 = ThisWorkbook.Path & "\" & "S # 2 Template " & Sheets("Welcome").Range("O28").Value & ".xlsm"
    relativePath3 = ThisWorkbook.Path & "\" & "S # 3 Template " & Sheets("Welcome").Range("O30").Value & ".xlsm"

    Set ws = ThisWorkbook.Worksheets(W(1))
    ws.Copy: Set wb = ActiveWorkbook
    For i = 2 To 9
    wb.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = W(i)
    Set ws = ThisWorkbook.Worksheets(W(i))
    Set ss = wb.Worksheets(W(i))
    ws.Copy ss: Next i
If Range("C27").Value = 1 Then GoTo Save1
If Range("C27").Value = 2 Then GoTo Save2
If Range("C27").Value <> 3 Then Exit Sub
    wb.SaveAs fileName:=relativePath3
Save2:
    wb.SaveAs fileName:=relativePath2
Save1:
    wb.SaveAs fileName:=relativePath1
    wb.Close SaveChanges:=True
End Sub

**Ppsych** · 01-23-2013, 03:27 PM

XLAdept- the new code runs... I think. I stopped it around the 4 minute mark, as I wasn't expecting much to happen after that point. It produced a workbook (Book1) with the correct tab names (but blank sheets) followed by a correct tab name with a 2, e.g., Information (2) that did contain the correct copied cells. The parts of the code dealing with naming the file, etc., might have run if I left it long enough. Thanks again for all of your help- I'll play around with it and see if I can resolve the multi-tab issue.

**xladept** · 01-23-2013, 04:01 PM

Maybe:

Sub Createtemplate2(): Dim ws As Worksheet, wb As Workbook, ss As Worksheet
Dim SheetName As String, W, i As Integer
MsgBox "This function creates the template."
    Dim relativePath1 As String
    Dim relativePath2 As String
    Dim relativePath3 As String
    W = Array(" ", "General_Instructions", "Information", "Instructions", _
        "Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments")
    relativePath1 = ThisWorkbook.Path & "\" & "S # 1 Template " & Sheets("Welcome").Range("O26").Value & ".xlsm"
    relativePath2 = ThisWorkbook.Path & "\" & "S # 2 Template " & Sheets("Welcome").Range("O28").Value & ".xlsm"
    relativePath3 = ThisWorkbook.Path & "\" & "S # 3 Template " & Sheets("Welcome").Range("O30").Value & ".xlsm"

        Set ws = ThisWorkbook.Worksheets(W(1))
        ws.Copy: Set wb = ActiveWorkbook
    For i = 2 To 9
        wb.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = W(i)
        Set ss = wb.Worksheets(W(i)): Set ws = ThisWorkbook.Worksheets(W(i))
        ws.Cells.Copy: ss.Range("A1").PasteSpecial xlPasteAll
    Next i
If Range("C27").Value = 1 Then GoTo Save1
If Range("C27").Value = 2 Then GoTo Save2
If Range("C27").Value <> 3 Then Exit Sub
    wb.SaveAs fileName:=relativePath3
Save2:
    wb.SaveAs fileName:=relativePath2
Save1:
    wb.SaveAs fileName:=relativePath1
    wb.Close SaveChanges:=True
End Sub

**Ppsych** · 01-23-2013, 04:35 PM

Progress! The pages copied with the correct sheet names and data, but workbook is still titled "Book2" (or Book3, or what-have-you). I'm going to play with it to try and figure out why the "save as" piece isn't grabbing the "ifs." Thanks again for the help!

**xladept** · 01-23-2013, 04:50 PM

Hi Ppsych,

The Save as isn't working???

**Ppsych** · 01-24-2013, 08:23 AM

No, it isn't. Running the code produces an unsaved workbook called Book(whatever). All the sheets are there, but it doesn't look like anything below "ws.Cells.Copy: ss.Range("A1").PasteSpecial xlPasteAll _ Next i" is working. No idea why, as of yet.

**Ppsych** · 01-24-2013, 02:24 PM

XLAdept- I finally got it working, using a different version of the "if" logic to make the "save as" play nicely with relativePath. I appreciate the help!

**xladept** · 01-24-2013, 02:32 PM

Hi Ppsych,

I tried the SaveAs code on my machine and it worked! Have you tried single stepping??

Good - you got it working - can I see the code change???

I thought of a change - I figured that it wasn't getting that c27 value:

Sub Createtemplate2(): Dim ws As Worksheet, wb As Workbook, ss As Worksheet
Dim SheetName As String, W, i As Integer, c27 As Integer
MsgBox "This function creates the template."
    Dim relativePath1 As String
    Dim relativePath2 As String
    Dim relativePath3 As String
    c27 = ThisWorkbook.Sheets("Welcome").Range("C27").Value
    W = Array(" ", "General_Instructions", "Information", "Instructions", _
        "Tasks", "K_Instructions", "Ks", "C_Instructions", "Comps", "Comments")
    relativePath1 = ThisWorkbook.Path & "\" & "S # 1 Template " & Sheets("Welcome").Range("O26").Value & ".xlsm"
    relativePath2 = ThisWorkbook.Path & "\" & "S # 2 Template " & Sheets("Welcome").Range("O28").Value & ".xlsm"
    relativePath3 = ThisWorkbook.Path & "\" & "S # 3 Template " & Sheets("Welcome").Range("O30").Value & ".xlsm"

        Set ws = ThisWorkbook.Worksheets(W(1))
        ws.Copy: Set wb = ActiveWorkbook
    For i = 2 To 9
        wb.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = W(i)
        Set ss = wb.Worksheets(W(i)): Set ws = ThisWorkbook.Worksheets(W(i))
        ws.Cells.Copy: ss.Range("A1").PasteSpecial xlPasteAll
    Next i
                If c27 = 1 Then GoTo Save1
                If c27 = 2 Then GoTo Save2
                If c27 <> 3 Then Exit Sub

    wb.SaveAs fileName:=relativePath3
Save2:
    wb.SaveAs fileName:=relativePath2
Save1:
    wb.SaveAs fileName:=relativePath1
    wb.Close SaveChanges:=True
End Sub

**Ppsych** · 01-25-2013, 09:00 AM

I just tried the new version of your code- it ran, but I got the same result... it produces a workbook with all of the correct sheets, but it's called Book1 and is unsaved. It must be something on my end if it's working for you.

Here is the code that is working for me, clumsy as it is. =) It now creates between 1 and 5 workbooks based on cell C24 (changed from C27), titled according to the relativePath. I just temporarily hide the sheets I don't want copied to the new workbooks.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Sheets("Welcome").Visible = False
    Dim relativePath1 As String
    relativePath1 = ThisWorkbook.Path & "\" & "S # 1 Template " & Sheets("Welcome").Range("C27").Value
    relativePath2 = ThisWorkbook.Path & "\" & "S # 2 Template " & Sheets("Welcome").Range("C29").Value
    relativePath3 = ThisWorkbook.Path & "\" & "S # 3 Template " & Sheets("Welcome").Range("C31").Value
    relativePath4 = ThisWorkbook.Path & "\" & "S # 4 Template " & Sheets("Welcome").Range("C33").Value
    relativePath5 = ThisWorkbook.Path & "\" & "S # 5 Template " & Sheets("Welcome").Range("C35").Value
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Visible = True Then
            Sh.Activate
            Sh.Cells.Copy
            Sh.Range("A1").PasteSpecial Paste:=xlValues
            Sh.Range("A1").Select
        End If
    Next Sh
    Application.CutCopyMode = False
    Sheets("Welcome").Visible = True
    Sheets("Welcome").Select
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs relativePath1, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    Application.ScreenUpdating = True
    
    If Sheets("Welcome").Range("C24") = 1 Then
    ActiveWorkbook.SaveAs relativePath1, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    
    ElseIf Sheets("Welcome").Range("C24") = 2 Then
    ActiveWorkbook.SaveAs relativePath1, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs relativePath2, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    
    ElseIf Sheets("Welcome").Range("C24") = 3 Then
    ActiveWorkbook.SaveAs relativePath1, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs relativePath2, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs relativePath3, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    
    ElseIf Sheets("Welcome").Range("C24") = 4 Then
    ActiveWorkbook.SaveAs relativePath1, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs relativePath2, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs relativePath3, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.SaveAs relativePath4, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    
    ElseIf Sheets("Welcome").Range("C24") = 5 Then
    ActiveWorkbook.SaveAs relativePath1, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs relativePath2, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs relativePath3, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs relativePath4, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs relativePath5, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
  End If
    
    Application.DisplayAlerts = True
    MsgBox "The workbook(s) you specified have been created in the same directory as the Master file.  The program will now close."
    Application.Quit
End Sub

**xladept** · 01-25-2013, 01:46 PM

Well, it's working!

Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Re: Export specific sheets into 1, 2, or 3 workbooks, depending on cell value

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions