Create New Workbook From Existing (minus some sheets)

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

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:

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

another option could be the next macro which also actually creates a new workbook:

Code:

---

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

---

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

Adaytay: We're THRILLED to have roos01 here. He is a known entity. :)

In that case, I am deeply honoured!! :cool:

Ad

Hi,

Similar approach to the above, but with a few amendments:

Code:

---

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

---