A macro (VBA) to group a number of worksheets

G

Guest

Guest
I want to write a macro that will select the pages in an open workbook and then save them to a new workbook.
The following example works provided the sheets have the name 1,2 or 3. My problem is that the sheets do not always have the same name. How can I modify this macro? or is there a better way.

Sub Macro1()
'
Sheets(Array("1", "2", "3")).Select
Sheets("3").Activate
Sheets(Array("1", "2", "3")).Copy Before:=Sheets(1)
End Sub

Thanks
John
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
On 2002-03-10 18:34, Anonymous wrote:
I want to write a macro that will select the pages in an open workbook and then save them to a new workbook.
The following example works provided the sheets have the name 1,2 or 3. My problem is that the sheets do not always have the same name. How can I modify this macro? or is there a better way.

Sub Macro1()
'
Sheets(Array("1", "2", "3")).Select
Sheets("3").Activate
Sheets(Array("1", "2", "3")).Copy Before:=Sheets(1)
End Sub

Thanks
John


Workbooks("Book1").Worksheets.Copy Before:=Workbooks("Book2").Sheets(1)
 
Upvote 0
Try this...

Sub SaveSheets_NewBook()
Dim Sh As Worksheet

For Each Sh In ActiveWorkbook.Sheets
Sh.Select False
Next

Sheets.Copy

Windows(ThisWorkbook.Name).Activate

End Sub


HTH

Ivan
 
Upvote 0
Thanks. Yes I knew I needed to change book1 and book2. More checking shows the problem lies in the book1 end, removing this reference allows the macro to run, but without much control.

In response to Ivans message this produces a runtime error 1004, method select of object_worksheet failed.

Prior to Ivans message I had modified the first response to:
Workbooks.Add Template:= _
"C:Program FilesMicrosoft OfficeTest.xlt"
Windows("test.xls").Activate
Worksheets.Copy Before:=Workbooks("Test1").Sheets(1)
and this seems to work.
 
Upvote 0
On 2002-03-10 18:34, Anonymous wrote:
I want to write a macro that will select the pages in an open workbook and then save them to a new workbook.
The following example works provided the sheets have the name 1,2 or 3. My problem is that the sheets do not always have the same name. How can I modify this macro? or is there a better way.

Sub Macro1()
'
Sheets(Array("1", "2", "3")).Select
Sheets("3").Activate
Sheets(Array("1", "2", "3")).Copy Before:=Sheets(1)
End Sub

Thanks
John

Going with Anonymous's code try:

ActiveWorkbook.Worksheets.Copy

This will copy all the worksheets in to a new workbook.

Regards,
 
Upvote 0
I thought all was ok vut the problem is that it is copying the hidden worksheets as well. Can anyone help me set it up so it will not copy the hidden worksheets?

Thanks
John
 
Upvote 0
On 2002-03-11 19:42, Anonymous wrote:
I thought all was ok vut the problem is that it is copying the hidden worksheets as well. Can anyone help me set it up so it will not copy the hidden worksheets?

Thanks
John

Try the following code:

<pre><font color='#000000'>
<font color='#000080'>Option</font> <font color='#000080'>Explicit</font>

<font color='#000080'>Sub</font> SheetArray()

<font color='#000080'>Dim</font> sht <font color='#000080'>As</font> Object
<font color='#000080'>Dim</font> astrSheets() <font color='#000080'>As</font> <font color='#000080'>Integer</font>
<font color='#000080'>Dim</font> intI <font color='#000080'>As</font> <font color='#000080'>Integer</font>

<font color='#000080'>For</font> Each sht In ActiveWorkbook.Sheets
<font color='#000080'>If</font> sht.Visible <font color='#000080'>Then</font>
intI = intI + 1
ReDim Preserve astrSheets(1 To intI)
astrSheets(intI) = sht.Index
<font color='#000080'>End</font> <font color='#000080'>If</font>
<font color='#000080'>Next</font> sht

Sheets(astrSheets).Copy Before:=Workbooks("Test1").Sheets(1)

<font color='#000080'>End</font> <font color='#000080'>Sub</font>

</font></pre>

Hope this helps,

Russell
 
Upvote 0

Forum statistics

Threads
1,213,483
Messages
6,113,919
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top