Copying/Saving Worksheets from a large workbook into separate files

[FrustratedoverVB]

I'm trying to copy and save worksheets from a large workbook into separate files. I also need to have the worksheets saved with the name of the tab as their file names and in the same path as the original workbook (which changes each month). The original workbook must remain intact. I've read several suggestions on other sites but most delete the original when saving the worksheets separately. Any direction that anyone can give would be greatly appreciated!!! I'm so lost on this one....

 

[FrustratedoverVB]

the indexing was the only thing that I'd used before.....is there a way to point to a particular worksheet and have the copy command begin after that sheet? There is a worksheet that is named the same thing in each of the workbooks.....I tried to add it in but I think that the macro is bumping up against the For Each statement.

 

[Norie]

Like I say I would not rely on using the Index.

If it's only a few sheets you want to exclude and you know there names then it's easy to exclude them.

Sub CreateNewWBS()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String
 
    Set wbThis = ThisWorkbook

    For Each ws In wbThis.Worksheets
        Select Case ws.Name
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet99"    ' add names of sheets to exclude
                ' do nothing
            Case Else
                strFilename = wbThis.Path & "/" & ws.Name
                ws.Copy
                Set wbNew = ActiveWorkbook
                wbNew.SaveAs strFilename
                wbNew.Close
        End Select
 
    Next ws

End Sub

PS The For Each could also cause problems because you can't always guarantee what the order it will loop will be.

 

[Craig Naylon]

Hi Guys,

How would the code from above be modified to Paste / Special with formatting? The worksheets I am using have a lot of formulas I don't want the final worksheets to have.

Here's the original code I am using:


Sub CreateNewWBS()</pre>
Dim wbThis As Workbook</pre>
Dim wbNew As Workbook</pre>
Dim ws As Worksheet</pre>
Dim strFilename As String</pre>
</pre>
Set wbThis = ThisWorkbook</pre>
For Each ws In wbThis.Worksheets</pre>
strFilename = wbThis.Path & "/" & ws.Name</pre>
ws.Copy</pre>
Set wbNew = ActiveWorkbook</pre>
wbNew.SaveAs strFilename</pre>
wbNew.Close</pre>
Next ws</pre>
End Sub

Thanks,
Craig

</pre>

 

[Golfboy1996]

Hi Guys, I like the code above so far, is there a way to separate all the sheets, but also copy a sheet called "Look Ups" to each new workbook?

If we could get that work, would there be a way to recombine the separate workbooks?

I have people filling out the sheets at the same time, and then I have to recombine them after they are done filling them out with number and comments.

 

[Norie]

What do you mean by recombine?

Copying each worksheet and a specific worksheet to a new workbook would be straightforward, for example.

Dim ws As Worksheet
Dim wb As Workbook

    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        If ws.Name <> "Look Ups" Then
            wb.Sheets(Array(ws.Name, "Look Ups")).Copy
        End If
    Next ws

 

[Golfboy1996]

I am not sure where to put this new code you gave me. Can you give me the full code with the sub?

For recombine, once the sheets are in there own workbooks, people will put numbers into a column. Then, I will need to combine them back into one workbook.
- I would not have to separate them, but only one person can have an excel file open at one time.
- I hope this make sense.

 

[Norie]

I think you should start a new thread, this one is almost 5 years old.

 

[Golfboy1996]

I am not sure how to put this new code in that was posted by Norie...I tried it like this, but I am not very good at VBA yet:

code:

Sub CreateNewWBS()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim wb As Workbook
Dim strFilename As String
 
    Set wbThis = ThisWorkbook
    For Each ws In wbThis.Worksheets
        Select Case ws.Name
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet99"    ' add names of sheets to exclude
                ' do nothing
            Case Else
                strFilename = wbThis.Path & "/" & ws.Name
                ws.Copy
                Set wbNew = ActiveWorkbook
                For Each ws In wbThis.Worksheets
                    If ws.Name <> "Look Ups" Then
                        wb.Sheets(Array(ws.Name, "Look Ups")).Copy
                    End If
                    wbNew.SaveAs strFilename
                    wbNew.Close
        End Select
 
    Next ws
End Sub

 

[Norie]

Please start a new thread.

 

[Golfboy1996]

I did start a new one, "separate all the sheets from one workbook, but also copy sheet called "Look Ups", then combine them"

I got the separating to work, now I just need the combining to work.

separating with Look Ups:

Sub CreateNewSBooks()
Dim ws As Worksheet
Dim wbThis As Workbook
Dim wbNew As Workbook
    Set wbThis = ThisWorkbook
    For Each ws In wbThis.Worksheets
        strFilename = wbThis.Path & "/" & ws.Name
        If ws.Name <> "Look Ups" Then
            wbThis.Sheets(Array(ws.Name, "Look Ups")).Copy
            Set wbNew = ActiveWorkbook
            wbNew.SaveAs strFilename
            wbNew.Close
        End If
    Next ws
End Sub