Consulting

Results 1 to 7 of 7

Thread: Solved: Create New Workbook From Existing (minus some sheets)

  1. #1
    VBAX Regular
    Joined
    May 2004
    Location
    Driffield, East Yorkshire, Egnland
    Posts
    69
    Location

    Question Solved: Create New Workbook From Existing (minus some sheets)

    Ok, here's one for you...

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

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

    Any ideas?

    Ad

  2. #2
    VBAX Regular
    Joined
    May 2004
    Location
    Driffield, East Yorkshire, Egnland
    Posts
    69
    Location
    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:
    [VBA]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[/VBA]

    Any ideas?

    Ad

  3. #3
    VBAX Regular
    Joined
    Jun 2004
    Location
    The Netherlands
    Posts
    34
    Location
    another option could be the next macro which also actually creates a new workbook:

    [VBA]
    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

    [/VBA]
    Last edited by roos01; 06-18-2004 at 07:20 AM.

  4. #4
    VBAX Regular
    Joined
    May 2004
    Location
    Driffield, East Yorkshire, Egnland
    Posts
    69
    Location

    Talking

    Welcome to the board Roos01

    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

  5. #5
    Site Admin
    The Princess
    VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    Adaytay: We're THRILLED to have roos01 here. He is a known entity.
    ~Anne Troy

  6. #6
    VBAX Regular
    Joined
    May 2004
    Location
    Driffield, East Yorkshire, Egnland
    Posts
    69
    Location
    In that case, I am deeply honoured!!

    Ad

  7. #7
    VBAX Contributor Richie(UK)'s Avatar
    Joined
    May 2004
    Location
    UK
    Posts
    188
    Location
    Hi,

    Similar approach to the above, but with a few amendments:[vba]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[/vba]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •