Group of Sheets to a New File

MrT82

Board Regular
Joined
Dec 12, 2005
Messages
84
Hi All,

I have used the following macro to save each sheet in my workbook as a new spreadsheet:

Sub SaveSheets()
Dim wb As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook

For Each ws In wb.Worksheets
ws.Copy
Set wbNew = ActiveWorkbook
wbNew.SaveAs "C:\" & ws.Name & ".xls"
Next
End Sub

Does anyone know if it is possible to run a macro that will select certain sheets presumably based on a look up table and save them in one new workbook and then select a further group and save them etc?

Thanks,

Paul
 

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Record a macro while doing it manually (Group the sheets you want to copy). That will give you some starting code.
 

MrT82

Board Regular
Joined
Dec 12, 2005
Messages
84
Thanks for this Andrew, any ideas how i can do it though if not all the tabs will always be there as it all depends on the result of the first macro that is ran...

Thanks,

Paul
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
What determines what sheets exist and how to want to group them? Try to give a real example.
 

MrT82

Board Regular
Joined
Dec 12, 2005
Messages
84
Hi Andrew,

I have a sheet called 'Trans' that basically has a list of items, which I run the following macro on to create a separate sheet for each recurring item. As per the below:

Sub SplitOutTransactions()
Dim Sh As Worksheet
Dim Rng As Range
Dim c As Range
Dim List As New Collection
Dim Item As Variant
Dim ShNew As Worksheet
Application.ScreenUpdating = False
' *** Change Sheet name to suit ***
Set Sh = Worksheets("Trans")
Set Rng = Sh.Range("B2:B" & Sh.Range("B65536").End(xlUp).Row)
On Error Resume Next
For Each c In Rng
List.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
'Set Rng = Sh.Range("A1:O" & Sh.Range("A65536").End(xlUp).Row)
Set Rng = Sh.Range("A1:K999")
For Each Item In List
Set ShNew = Worksheets.Add
ShNew.Name = Item

' change from field 2
Rng.AutoFilter Field:=1, Criteria1:=Item
Rng.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A1")
Rng.AutoFilter
ShNew.Columns("A:B").Delete
Next Item
Sh.Activate
Application.ScreenUpdating = True
End Sub

I was then going to create a separate sheet with a list of possible values and the file that they should be saved in, which I thought a macro could look up against?

I.e.

CC Save With
55011 Group 1
55012 Group 2
55021 Group 1
55030 Group 3
55015 Group 2

Any ideas? Hopefully this makes sense…
:confused:
 

Watch MrExcel Video

Forum statistics

Threads
1,118,331
Messages
5,571,578
Members
412,407
Latest member
ElmerCC
Top