Copy part of sheets to new workbook

husoi

Board Regular
Joined
Sep 12, 2012
Messages
50
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.
 

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,965
Office Version
365
Platform
Windows
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:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,965
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

husoi

Board Regular
Joined
Sep 12, 2012
Messages
50
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,965
Office Version
365
Platform
Windows
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
 

husoi

Board Regular
Joined
Sep 12, 2012
Messages
50
It works perfectly :)

thank you sooooo much ;)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,965
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

husoi

Board Regular
Joined
Sep 12, 2012
Messages
50
Oh you won't get rid of me that easily :p

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 :) :biggrin:
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,965
Office Version
365
Platform
Windows
Not a problem, but you will need to start a new thread if you get stuck
 

Watch MrExcel Video

Forum statistics

Threads
1,099,596
Messages
5,469,607
Members
406,661
Latest member
west5405

This Week's Hot Topics

Top