Results 1 to 10 of 10

Thread: Copy part of sheets to new workbook

  1. #1
    New Member
    Join Date
    Sep 2012
    Location
    Fife, Scotland
    Posts
    48
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Copy part of sheets to new workbook

    Hi all,

    Tried to find a solution for this but it seems I'll be the first to attempt it.

    I have a workbook containing several sheets, there are 7 permanent sheets that I have renamed as Sheet01 to Sheet07 and a growing number of other sheets.
    A macro allows the users to create a new set (project) which duplicates 2 templates among other actions like retrieving information from an external source.
    This has been working before but the workbook has become ginormous and takes forever to calculate.

    So I decided to split it in 2 documents, 1 does the importing (the above action) while the second will work as reporting tool.
    The import bit I managed to make it work with no issues.

    What I need to produce now is a macro that will copy the sheets from Sheet07 (excluding it) to the last one (latest).
    The newer sheets will have as name 6 or 8 digits and characters a space and ending with M and E (123456 M, 123456 E or 123456.1 M 123456.1 E).
    My initial approach was to try to use something like:

    Dim r As Long, lr As Long
    Dim sh As Worksheet


    For Each sh In Worksheets(Array(sheet08.Name, , sheet10000.Name))
    sh.Copy After:=Workbooks("Book.xlsm").Sheets(Workbooks("Book.xlsm").Worksheets.Count)


    Next

    The intention was that the macro would ignore all sheets before Sheet08 and will copy everything after it in this case to a limit of 10,000 sheets.
    I am under the impression that Array used in the way I'm trying to doesn't work.

    The question:

    What is the code that I should use?

    thank you in advance.

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    23,960
    Post Thanks / Like
    Mentioned
    408 Post(s)
    Tagged
    42 Thread(s)

    Default Re: Copy part of sheets to new workbook

    If the sheets Sheet01 to Sheet07 are always the first 7 sheets in the book, try
    Code:
    For i = 8 To ThisWorkbook.Sheets.Count
       ThisWorkbook.Sheets(i).Copy , Workbooks("Book.xlsm").Sheets(Workbooks("Book.xlsm").Worksheets.Count)
    Next i
    Last edited by Fluff; Jun 10th, 2019 at 09:34 AM.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  3. #3
    New Member
    Join Date
    Sep 2012
    Location
    Fife, Scotland
    Posts
    48
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy part of sheets to new workbook

    Thank you Fluff. it works a treat

  4. #4
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    23,960
    Post Thanks / Like
    Mentioned
    408 Post(s)
    Tagged
    42 Thread(s)

    Default Re: Copy part of sheets to new workbook

    You're welcome & thanks for the feedback
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  5. #5
    New Member
    Join Date
    Sep 2012
    Location
    Fife, Scotland
    Posts
    48
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy part of sheets to new workbook

    After all the code didn't really work...
    I think is to do with the sheet number, or something that I'm missing.
    So I went back to drawing board

    I opted to get the sheets that the name includes the M and E and copy those instead of counting them and hope for the best.

    I changed the code for this one:

    Sub copysht()
    Dim wrkS As Workbook
    Dim wrkT As Workbook
    Dim r As Long, lr As Long
    Dim sh As Worksheet


    Workbooks("source book.xlsm").Activate
    Set wrkS = ActiveWorkbook
    Workbooks("target book.xlsm").Activate
    Set wrkT = ActiveWorkbook

    wrkS.Activate
    For i = 1 To wrkS.Sheets.Count
    If Worksheets(i).Name Like "* M" Or Worksheets(i).Name Like "* E" Then
    Worksheets(i).Copy after:=Workbooks("target book.xlsm").Sheets _
    (Workbooks("target book.xlsm").Worksheets.Count)

    End If


    Next i


    End Sub

    Now, this kinda works...
    Shame that it copies the first sheet 9 times instead all 8 sheets that end either as M or E.

  6. #6
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    23,960
    Post Thanks / Like
    Mentioned
    408 Post(s)
    Tagged
    42 Thread(s)

    Default Re: Copy part of sheets to new workbook

    Is this any better?
    Code:
    Set wrkS = Workbooks("source book.xlsm")
    Set wrkT = Workbooks("target book.xlsm")
    
    For i = 1 To wrkS.Sheets.Count
       If wrkS.Worksheets(i).name Like "* M" Or wrkS.Worksheets(i).name Like "* E" Then
          wrkS.Worksheets(i).Copy after:=wrkT.Sheets(wrkT.Worksheets.Count)
       End If
    Next i
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  7. #7
    New Member
    Join Date
    Sep 2012
    Location
    Fife, Scotland
    Posts
    48
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy part of sheets to new workbook

    It works perfectly

    thank you sooooo much

  8. #8
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    23,960
    Post Thanks / Like
    Mentioned
    408 Post(s)
    Tagged
    42 Thread(s)

    Default Re: Copy part of sheets to new workbook

    You're welcome & thanks for the feedback
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  9. #9
    New Member
    Join Date
    Sep 2012
    Location
    Fife, Scotland
    Posts
    48
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy part of sheets to new workbook

    Oh you won't get rid of me that easily

    This is just a tiny part of the code I'm creating.

    The whole thing will (hopefully)
    open the source file with a prompt,
    copy the sheets (this bit)
    will identify if the same sheet already exists (for updates) and if yes will skip to next one
    will fill a row in a table with the names of the sheets so it retrieves the data in them
    will close the source file

    So, as you can see, plenty of scope for me to come back and bother you
    Last edited by husoi; Jun 14th, 2019 at 09:04 AM.

  10. #10
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    23,960
    Post Thanks / Like
    Mentioned
    408 Post(s)
    Tagged
    42 Thread(s)

    Default Re: Copy part of sheets to new workbook

    Not a problem, but you will need to start a new thread if you get stuck
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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