View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default <Tom Ogilvy Copying Sheets to New Workbook

Application.DisplayAlerts = False
' do the copy
Application.DisplayAlerts = True



another way and probably the best way, would be to build an array of
sheetnames and copy everything at once.

Private Sub CommandButton3_Click()

' this code builds a new workbook

Application.ScreenUpdating = False ' turn off screen updating

Dim NWB As Workbook, EWB As Workbook, NewName As String
Dim SRN As String, Block As Range
Dim v() as String

Redim v(0 to 1)

Set EWB = ActiveWorkbook ' store the active workbook name
NewName = ""
NewName = InputBox("Please enter the name for the new workbook without
the .xls ")

' Set NWB = Workbooks.Add ' add new workbook

v(0) = "Name1"
v(1) = "Name2"

' copy the sheets'
' EWB.Sheets("Name1").Copy NWB.Sheets(1)
' EWB.Sheets("Name2").Copy NWB.Sheets(1)

For Each Block In EWB.Worksheets("List Data").Range("Stream_Summaries")

SRN = Block.Value ' store summary sheet name
redim preserve v(0 to ubound(v) + 1)
v(ubound(v)) = SRN
Next
' copy the sheets and create the new workbook with
' one command
EWB.Sheets(v).copy
set NWB = Activeworkbook

--
Regards,
Tom Ogilvy


"Ray Batig" wrote in message
ink.net...
Thanks Tom!!

You were right on. One name had an extra space in it. When I copy the
sheets, I get a message that says that the sheet has a range in it and do

I
want to use the current one. The answer is yes. is there a way to suppress
these questions or automatically answer them?

Thanks again for your help!

Ray

Tom Ogilvy wrote in message
...
subscript out of range would indicate that

SRN is not a valid sheet name for a sheet in EWB.

You going to have to check the names. Make sure you don't have extra

spaces
or something.

--
Regards,
Tom Ogilvy



"Ray Batig" wrote in message
k.net...
Greetings,

I wrote the following code which is in a sheet, and am having trouble
figuring out what is going wrong. Basically I have a workbook that has

a
number of sheets say Name1, Name2, Bill1, Sam1, Sam2, Sam3. At the

click
of
a button, I want to generate a new workbook and then copy the desired

sheets
into the new workbook. The names Sam1, Sam2, Sam3, are in the range
"Stream_Summaries". Everything works until I get to the marked line

where
I
start to copy Sam1. Then I get a SUBSCRIPT OUT OF RANGE error.

This code worked beautifully when there was only Sam1 and I recently

had
to
add the For each... and that is when the fun started.

Can someone tell me what is going on since I am lost?

Thanks in advance for your help!

Ray

Private Sub CommandButton3_Click()

' this code builds a new workbook

Application.ScreenUpdating = False ' turn off screen updating

Dim NWB As Workbook, EWB As Workbook, NewName As String
Dim SRN As String, Block As Range

Set EWB = ActiveWorkbook ' store the active workbook name
NewName = ""
NewName = InputBox("Please enter the name for the new workbook

without
the .xls ")

Set NWB = Workbooks.Add ' add new workbook

' copy the sheets
EWB.Sheets("Name1").Copy NWB.Sheets(1)
EWB.Sheets("Name2").Copy NWB.Sheets(1)

For Each Block In EWB.Worksheets("List

Data").Range("Stream_Summaries")
'loop thru summaries
SRN = Block.Value ' store summary sheet name
EWB.Sheets(SRN).Copy NWB.Sheets(1) << line with error


........ more code