Copy part of sheets to new workbook

[husoi]

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.

 

[Fluff]

If the sheets Sheet01 to Sheet07 are always the first 7 sheets in the book, try

For i = 8 To ThisWorkbook.Sheets.Count
   ThisWorkbook.Sheets(i).Copy , Workbooks("Book.xlsm").Sheets(Workbooks("Book.xlsm").Worksheets.Count)
Next i

 

[husoi]

Thank you Fluff. it works a treat

 

[Fluff]

You're welcome & thanks for the feedback

 

[husoi]

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.

 

[Fluff]

Is this any better?

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

 

[husoi]

It works perfectly

thank you sooooo much

 

[Fluff]

You're welcome & thanks for the feedback

 

[husoi]

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

 

[Fluff]

Not a problem, but you will need to start a new thread if you get stuck