Creating New Workbooks From Worksheets in Different Workbooks

[Panda2000]

I have sales reports that need to be created from two different workbooks that contain worksheets that need to be put into new workbooks. In the "Revenue" workbook there are two sheets entitled "Revenue by Territory" and "Territory by Volume" that are summaries of the total sales data by each territory. These two sheets should be pasted into each new workbook created. In the "Revenue" workbook there are unique additional worksheets(approximately 70) and one of these worksheets should be pasted into its own workbook along with the two summary worksheets"Revenue by Territory" and "Volume by Territory". In the "Volume" workbook there are sheets that need to be added to the new workbooks created from the "Revenue" data. These sheets are all in the same order in both the "Revenue" and "Volume" workbooks, and have the same names with the exception of a "vol" and "rev" added to the end. I have tried to put together some code borrowed from Jbeaucaire for the first part of this, but there are obvious problems with it and it is incomplete. Any help with this would be greatly appreciated.

Sub SheetsToBooks()
'Jerry Beaucaire  (10/22/2009)
'Creates a separate workbook for each sheet, saved with sheetname + Date
Dim ws As Worksheet, savePath As String, MyStr As String

savePath = "C:\Users\Documents\"   'do not forget the closing \ in this string

    For Each ws In ThisWorkbook.Worksheets
              Sheets(Array("Revenue by Territory", "Volume by Territory")).Select
              Sheets("Volume by Territory").Activate
              Sheets(Array("Revenue by Territory", "Volume by Territory")).Copy
        MyStr = ws.Name & " " & Format(Date, "mm-dd-yy")
        ws.Copy        'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        ActiveWorkbook.SaveAs Filename:=savePath & MyStr, FileFormat:=xlNormal
        
    Next ws

End Sub

[xladept]

Hi Panda2000,

From which Workbook should the program be run? It looks to be that you must start with a fresh book!

[Panda2000]

Hi again XL,
It should be run from the revenue workbook and copy the worksheets to new workbooks and then take the worksheets from the volume workbook and put them into the newly created workbooks.

[xladept]

I'll try it again tomorrow - looks like it's working, but I'll let you know.

[xladept]

Hi Panda2000,

Thanks for the reps. Your JBeaucaire program seems to be working. I inserted it into a module into the revenue book and it ran straight out. Just check your path name and, if everything is copacetic, it looks like you're in business!

[Panda2000]

Hi XL,
I also needed for the worksheets in the "volume" workbook to be copied into the new workbooks that have been created for each sales territory. I'm having trouble with that as I'm not quite sure how to reference the existing workbooks when pulling in the worksheets from the "volume" workbook. The worksheets are in sequence in the "volume" and "revenue" workbooks, and are named identically with the exception of a "vol" or "rev" string at the end. The final output should be a series of about 70 new workbooks each containing a unique sheet for each territory, one from the "volume" workbook and one from the "revenue" workbook, and also two more summary sheets "volume by territory" and "revenue by territory" which contain summary data.

[xladept]

Hi Panda2000,

I altered the routine to include both Workbooks - but I didn't address the summary sheets:

Sub SheetsToBooks()
'Jerry Beaucaire  (10/22/2009)
'Creates a separate workbook for each sheet, saved with sheetname + Date
Dim wr As Worksheet, wv As Worksheet, savePath As String, MyStr As String
Dim ThisBook As Workbook, ThatBook As Workbook
Set ThatBook = Workbooks("volume.xlsx"): Set ThisBook = Workbooks("Revenue.xlsx")

savePath = "C:\Users\Documents\"   'do not forget the closing \ in this string

    For Each wr In ThisBook.Worksheets
              Sheets(Array("Revenue by Territory", "Volume by Territory")).Select
              Sheets("Volume by Territory").Activate
              Sheets(Array("Revenue by Territory", "Volume by Territory")).Copy
        MyStr = wr.Name & " " & Format(Date, "mm-dd-yy")
        wr.Copy        'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        'ActiveWorkbook.SaveAs Filename:=savePath & MyStr, FileFormat:=xlNormal
        
    Next wr
    
    For Each wv In ThatBook.Worksheets
              Sheets(Array("Revenue by Territory", "Volume by Territory")).Select
              Sheets("Volume by Territory").Activate
              Sheets(Array("Revenue by Territory", "Volume by Territory")).Copy
        MyStr = wv.Name & " " & Format(Date, "mm-dd-yy")
        wv.Copy        'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        ActiveWorkbook.SaveAs Filename:=savePath & MyStr, FileFormat:=xlNormal
        
    Next wv

End Sub

[Panda2000]

Hi again XL,

Thank you for your work on this but there is an issue. The "rev" and "vol" worksheets for the same territory should go into the same workbook. As the code is now it is putting these two sheets in different workbooks. For example there is a TX, Dalllas East (rev) and TX, Dallas East (vol) worksheet, these should both be in the same workbook. There's actually a third sheet that I need to add in as well entitled "data", but if you can help me put together something for the first two worksheets I'll try to add in the third one on my own. Thanks again for all of the help.

[Panda2000]

I'll attempt to incorporate the summary sheets, and sheets from a third workbook on my own. I'll do my best, but I may have a few more questions. Thank you very much for the help with this.

[xladept]

Hi Panda2000,

You're welcome as well as any questions I might be able to answer.

[xladept]

Hi Panda2000,

Try this:

Sub SheetsToBooks()
'Jerry Beaucaire  (10/22/2009) - XLAdept 7/25/2012
'Creates a separate workbook for each sheet, saved with sheetname + Date
Dim wr As Worksheet, wv As Worksheet, savePath As String, MyStr As String
Dim ThisBook As Workbook, ThatBook As Workbook, R As String, V As String

Set ThatBook = Workbooks("volume.xlsx"): Set ThisBook = Workbooks("Revenue.xlsx")

savePath = "C:\Users\Documents\"   'do not forget the closing \ in this string

    For Each wr In ThisBook.Worksheets
If wr.Name = "Revenue by Territory" Or wr.Name = "Volume by Territory" Then GoTo NextRev
              Worksheets(Array("Revenue by Territory", "Volume by Territory")).Select
              Worksheets("Volume by Territory").Activate
              Worksheets(Array("Revenue by Territory", "Volume by Territory")).Copy
        MyStr = wr.Name & " " & Format(Date, "mm-dd-yy")
        wr.Copy After:=Worksheets(Worksheets.Count)
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        
    R = wr.Name: R = Left(R, InStr(1, R, "(") - 1)
    
    For Each wv In ThatBook.Worksheets
    
    V = wv.Name: V = Left(V, InStr(1, V, "(") - 1)
    
    If V = R Then
        wv.Copy After:=Worksheets(Worksheets.Count)       'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        ActiveWorkbook.SaveAs Filename:=savePath & MyStr, FileFormat:=xlNormal
    End If
    Next wv
        
NextRev: Next wr: End Sub

[Panda2000]

Thanks for the work on this XLAdept. I will take a look at it and attempt to add in the third data sheet....

[xladept]

You're welcome!

Oh! I thought of a little enhancement to speed it up:

GoTo NextRev: End If
    Next wv

Instead of recycling after a match.

[Panda2000]

Hi again XLAdept,
Well I'm attempting to add in the third workbook but it looks like I've managed to mess up your code..

Sub SheetsToBooks()
'Jerry Beaucaire  (10/22/2009) - XLAdept 7/25/2012
'Creates a separate workbook for each sheet, saved with sheetname + Date

Dim wr As Worksheet, wv As Worksheet, wd As Worksheet, savePath As String, MyStr As String
Dim ThisBook As Workbook, ThatBook As Workbook, R As String, V As String

Set ThatBook = Workbooks("volume.xlsx"): Set ThisBook = Workbooks("Revenue.xlsx"): Set ThirdBook = Workbooks("Data.xlsx")

savePath = "C:\Users\Documents\"
 'MyExcelApp.DisplayAlerts = False
    For Each wr In ThisBook.Worksheets
If wr.Name = "Revenue by Territory" Or wr.Name = "Volume by Territory" Then GoTo NextRev
              Worksheets(Array("Revenue by Territory", "Volume by Territory")).Select
              Worksheets("Volume by Territory").Activate
              Worksheets(Array("Revenue by Territory", "Volume by Territory")).Copy
        MyStr = wr.Name & " " & Format(Date, "mm-dd-yy")
        wr.Copy After:=Worksheets(Worksheets.Count)
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        
    R = wr.Name: R = Left(R, InStr(1, R, "(") - 1)
    
    For Each wv In ThatBook.Worksheets
    
    V = wv.Name: V = Left(V, InStr(1, V, "(") - 1)
    
    If V = R Then
        wv.Copy After:=Worksheets(Worksheets.Count)       'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=savePath & MyStr, FileFormat:=xlNormal
        
        
    End If
    
    For Each wd In ThirdBook.Worksheets
    
    T = wd.Name: T = Left(T, InStr(1, T, "(") - 1)
    
    If T = V Then
        wd.Copy After:=Worksheets(Worksheets.Count)       'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=savePath & MyStr, FileFormat:=xlNormal
        
        
    End If
    
    Next wd
    Next wv
        
NextRev: Next wr: End Sub

[xladept]

Hi Panda2000,

Try this:

Sub SheetsToBooksD()
'Jerry Beaucaire  (10/22/2009) - XLAdept 7/25/2012
'Creates a separate workbook for each sheet, saved with sheetname + Date

Dim wr As Worksheet, wv As Worksheet, wd As Worksheet, savePath As String, MyStr As String
Dim ThisBook As Workbook, ThatBook As Workbook, ThirdBook As Workbook, R As String, V As String, T As String

Set ThatBook = Workbooks("volume.xlsx"): Set ThisBook = Workbooks("Revenue.xlsx"): Set ThirdBook = Workbooks("Data.xlsx")

savePath = "C:\Users\Documents\"
 'MyExcelApp.DisplayAlerts = False
    For Each wr In ThisBook.Worksheets
If wr.Name = "Revenue by Territory" Or wr.Name = "Volume by Territory" Then GoTo NextRev
              Worksheets(Array("Revenue by Territory", "Volume by Territory")).Select
              Worksheets("Volume by Territory").Activate
              Worksheets(Array("Revenue by Territory", "Volume by Territory")).Copy
        MyStr = wr.Name & " " & Format(Date, "mm-dd-yy")
        wr.Copy After:=Worksheets(Worksheets.count)
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        
    R = wr.Name: R = Left(R, InStr(1, R, "(") - 1)
    
    For Each wv In ThatBook.Worksheets
    
    V = wv.Name: V = Left(V, InStr(1, V, "(") - 1)
    
    If V = R Then
        wv.Copy After:=Worksheets(Worksheets.count)       'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        Application.DisplayAlerts = False
        
    Exit For: End If
    Next wv
    
    For Each wd In ThirdBook.Worksheets
    
    T = wd.Name: T = Left(T, InStr(1, T, "(") - 1)
    
    If T = V Then
        wd.Copy After:=Worksheets(Worksheets.count)       'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=savePath & MyStr, FileFormat:=xlNormal
        
        
    GoTo NextRev: End If
    
    Next wd
    
        
NextRev: Next wr: End Sub

[Panda2000]

It's working really great. Thank you very much for your help with this. I'll spend today going over it and if I have any questions on the third worksheet I'l probably query you tomorrow about it. Thanks again XL.

[xladept]

You're welcome again! I'm so pleased to hear that it works!

[Panda2000]

Very excellent XL. If it's not too much trouble would you mind commenting the syntax of the looping structure, just so it's clear to me. I'd really like to understand this code so I can build on my limited VBA knowledge base... thanks again.

[xladept]

Hi Panda2000,

I often think that the code speaks for itself - so I'm not adept at commentary - but here you go:

Sub SheetsToBooksD()
'Jerry Beaucaire  (10/22/2009) - XLAdept 7/25/2012
'Creates a separate workbook for each sheet, saved with sheetname + Date

Dim wr As Worksheet, wv As Worksheet, wd As Worksheet, savePath As String, MyStr As String
Dim ThisBook As Workbook, ThatBook As Workbook, ThirdBook As Workbook, R As String, V As String, T As String

Set ThatBook = Workbooks("volume.xlsx"): Set ThisBook = Workbooks("Revenue.xlsx"): Set ThirdBook = Workbooks("Data.xlsx")

savePath = "C:\Users\Documents\"   '(with the This & That the program doesn't need to be run from any specific Workbook)
 
    For Each wr In ThisBook.Worksheets                  'Cycle once through each sheet in the Revenue book
If wr.Name = "Revenue by Territory" Or wr.Name = "Volume by Territory" Then GoTo NextRev 'eliminate gratuitous books
              Worksheets(Array("Revenue by Territory", "Volume by Territory")).Select
              Worksheets("Volume by Territory").Activate                                'this is Jerry's code
              Worksheets(Array("Revenue by Territory", "Volume by Territory")).Copy
        MyStr = wr.Name & " " & Format(Date, "mm-dd-yy")
        wr.Copy After:=Worksheets(Worksheets.count)
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        
    R = wr.Name: R = Left(R, InStr(1, R, "(") - 1) 'Remove the (rev) at the end
    
    For Each wv In ThatBook.Worksheets       'Cycle through each sheet in the Volume book each time
    
    V = wv.Name: V = Left(V, InStr(1, V, "(") - 1) 'Remove the (vol) at the end
    
    If V = R Then
        wv.Copy After:=Worksheets(Worksheets.count)       'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
               
    Exit For: End If                                  'Only need to cycle until a match
    Next wv
    
    For Each wd In ThirdBook.Worksheets             'Cycle through each sheet in the Data book each time
    
    T = wd.Name: T = Left(T, InStr(1, T, "(") - 1)   'Remove the (whatever) at the end
    
    If T = V Then
        wd.Copy After:=Worksheets(Worksheets.count)       'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=savePath & MyStr, FileFormat:=xlNormal  'After book is built then save it
        
        
    GoTo NextRev: End If                                'Only need to cycle until a match
    
    Next wd
    
        
NextRev: Next wr: End Sub

[Panda2000]

I'm not quite clear on this portion of code .. it is obviously copying to the new workbook that was created in the prior step, but I'm not quite clear on how the syntax is referencing the newly created workbook; I note that the code copies a worksheet in the "wd" workbook, but not sure how it "knows" to go to the previous workbook to paste the data. Obviously "After:=Worksheets(Worksheets.count)" is sufficient for the code to do this, but would you mind explaining this a little bit more in depth to me?

wv.Copy After:=Worksheets(Worksheets.count)

[xladept]

Hi Panda2000,

If you just said copy with nothing following then it would create a whole new book - the default is to copy before but then when you went to write on it it wouldn't be the last sheet and it wouldn't work.

[Panda2000]

I'm still not quite clear on how the code is referencing the newly created workbook. For example in this portion of code Excel is copying from the Volume workbook, but where in the code does it indicate for it to paste into the newly created workbook from the previous lines of code? Sorry if I'm being a pain, I'm just trying to fully understand the code...

For Each wv In ThatBook.Worksheets       'Cycle through each sheet in the Volume book each time
    
    V = wv.Name: V = Left(V, InStr(1, V, "(") - 1) 'Remove the (vol) at the end
    
    If V = R Then
        wv.Copy After:=Worksheets(Worksheets.count)       'copies sheet to new workbook
        Cells.Copy     'removing all formulas
        Range("A1").PasteSpecial xlPasteValues
               
    Exit For: End If                                  'Only need to cycle until a match
    Next wv

[xladept]

Hi Panda,

It doesn't hurt to remind myself of these things either. In answer to your question:

This creates the new book:

Worksheets(Array("Revenue by Territory", "Volume by Territory")).Copy

but where in the code does it indicate for it to paste into the newly created workbook from the previous lines of code? Sorry if I'm being a pain, I'm just trying to fully understand the code...

These lines paste into the new book:

wr.Copy After:=Worksheets(Worksheets.Count)
.
.
.
wv.Copy After:=Worksheets(Worksheets.Count)         
.
.
.
wd.Copy After:=Worksheets(Worksheets.Count)

[Panda2000]

I see, so my understanding was a bit off. I guess I'm still stuck in that macro recorder line of thinking where first the data has to be selected and then pasted. In this instance you are just telling excel where to copy the data from without actively selecting that workbook, so there's no need to "reselect" the newly created workbook since it is already still active. Is this line of thinking correct?

[xladept]

Yeah - most times the solitary copy command will just copy to the clipboard - one way of thinking about the copy command is as "copy to", and it can't copy a whole worksheet to the clipboard.

[Panda2000]

One more XL,
I don't quite understand what Nextrev is; I can see that it is referencing the next worksheet but not understanding it fully. Also the function of the colon in the last line of code, I'm a little unclear on as well.

GoTo NextRev: End If
    
    Next wd
    
        
NextRev: Next wr: End Sub

[xladept]

NextRev: is a procedure - notice that it is followed by a colon - you branch to procedures with the GoTo command. You can insert procedures with names of your own devising anywhere in your program to provide for processing control - and jump to them by invoking their name without the colon. A possible point of confusion is the double usage of the colon - I also use it to condense the lines in my code, the classical code would read:

GoTo NextRev
End If
    
    Next wd
            
NextRev: 
Next wr
 End Sub

[Panda2000]

A sincere thanks for your patience and help with this XL. Have a great weekend!

[xladept]

Hi Panda2000,

You're welcome and have a great weekend yourself!