View Full Version : Solved: Create New Workbook From Existing (minus some sheets)

06-18-2004, 06:04 AM
Ok, here's one for you... :whip

I want to copy every sheet in a workbook EXCEPT for four specific, named ones, into a new workbook. :type

The names of the sheets in the workbook to be copied can be either the same or different every time. :help (The sheets that are NOT to be copied remain the same at all times).

Any ideas?


06-18-2004, 06:31 AM
Here's some of the work that I've done so far. The procedure below (a very quickly knocked-up one) will create the text string which contains the sheet names in the standard "sheet1", "sheet2", "sheet3"... format.

How on earth do I pass this through to the sheets collection so that it selects the required sheets?

Here's the code:
Public Sub TestSheetsCopy()

Dim strSheets As String, w

strSheets = """"

For Each w In ActiveWorkbook.Worksheets
Select Case w.Name
Case "Control Screen", "AllData", "Pivots", "Data"
'Do Nothing
Case Else
strSheets = strSheets & w.Name & """, """
End Select

strSheets= Left(strSheets, Len(strSheets) - 3)
MsgBox strSheets

'Sheets(Array(strSheets)).Select - doesn't work
'Sheets(strSheets).Select - doesn't work

End Sub

Any ideas?


06-18-2004, 06:36 AM
another option could be the next macro which also actually creates a new workbook:

Sub CopySheets()
Dim ws As Worksheet
Application.DisplayAlerts = False
actwb = ActiveWorkbook.Name
Set NewBook = Workbooks.Add(1) ' adds a new workbook
filenm = "test2f.xls" 'assign the new workbooks names
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & filenm
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "Sheet1", "Sheet2", "Sheet3", "Sheet4" 'these are the for sheets names which shouldn't be copied
Case Else
ws.Copy Before:=Workbooks(filenm).Sheets(1)
End Select
Next ws
Application.DisplayAlerts = True
End Sub

06-18-2004, 06:43 AM
Welcome to the board Roos01 :006:

:band: :ole: :bigdance2 :ipray: :ipray: WELCOME!!

Hi ... and what a first post!

Nice.... I like your thinking - and it certainly looks like it will do the trick. Thank you! I knew exactly what I was after but Friday-afternoon-itus had attacked with some vengence...


Anne Troy
06-18-2004, 07:25 AM
Adaytay: We're THRILLED to have roos01 here. He is a known entity. :)

06-18-2004, 07:41 AM
In that case, I am deeply honoured!! :cool:


06-18-2004, 08:33 AM

Similar approach to the above, but with a few amendments:Sub CopySheets2()
Dim ws As Worksheet, bFirst As Boolean, wbkNew As Workbook

bFirst = True
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Sheet4", "Sheet5", "Sheet6", "Sheet7"
'these are the sheets names which shouldn't be copied
Case Else
If bFirst = True Then
Set wbkNew = ActiveWorkbook
bFirst = False
'with the first sheet copied, create a new workbook
ws.Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
'add subsequent copies to the new workbook
End If
End Select
Next ws
wbkNew.SaveAs FileName:="Test.xls"

End Sub