PDA

View Full Version : [SOLVED] Create New Workbook From Existing (minus some sheets)



Adaytay
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?

Ad

Adaytay
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
Next
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?

Ad

roos01
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
Workbooks(actwb).Activate
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
Workbooks(actwb).Activate
ws.Select
ws.Copy Before:=Workbooks(filenm).Sheets(1)
End Select
Next ws
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub

Adaytay
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...

Ad

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

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

Ad

Richie(UK)
06-18-2004, 08:33 AM
Hi,

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
ws.Copy
Set wbkNew = ActiveWorkbook
bFirst = False
'with the first sheet copied, create a new workbook
Else
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"
wbkNew.Close
End Sub