Copying multiple sheets into a NEW workbook

[kev_06]

Thanks for the help, but I still have a question. I've used the
following lines of code to take selected values from a list box and
copy the sheets. The code shown does this EXCEPT I need the multiple
sheets copied into a new, seperate workbook. If I take out the
after:=Worksheets(Worksheets.Count) line, I can only get 1 sheet copied
into a new workbook. Is there any way to copy all the sheets (could be
as many as 60) to the new workbook?

Dim Ndx As Long
With Me.ListBox1
For Ndx = 0 To .ListCount - 1
If .Selected(Ndx) = True Then
Worksheets(.List(Ndx)).Copy
after:=Worksheets(Worksheets.Count)
End If
Next Ndx
End With

 

[Dave Peterson]

One way is to create a new workbook first and then just plop the sheets into
that new workbook.

dim newwkbk as workbook
Dim Ndx As Long

set newwkbk = workbooks.add(1) 'single sheet
newwkbk.worksheets(1).name = "deletemelater"
With Me.ListBox1
For Ndx = 0 To .ListCount - 1
If .Selected(Ndx) = True Then
Worksheets(.List(Ndx)).Copy _
after:=newwkbk.worksheets(newwkbk.worksheets.count)
End If
Next Ndx
End With

if newwkbk.worksheets.count = 1 then
newwkbk.close savechanges:=false 'no other sheets copied
else
application.displayalerts = false
newwkbk.worksheets("deletemelater").delete
application.displayalerts = true
end if

============
Or you could build an array of the worksheet names and copy those sheets in one
copy.

dim myArr() as string
dim wCtr as long
Dim Ndx As Long

With Me.ListBox1
wCtr = 0
redim myArr(1 to .listcount)
For Ndx = 0 To .ListCount - 1
If .Selected(Ndx) = True Then
wctr = wctr + 1
myArr(wctr) = .list(ndx)
End If
Next Ndx
End With

if wctr = 0 then
'do nothing, nothing selected
else
redim preserve myArr(1 To wCtr)
worksheets(myarr).copy
end if

 

[Dave Peterson]

ps. Watch out for typos. I didn't test those and didn't compile them.