Copy Multiple Tabs to a new workbook

[Raddle]

Hi

I have a set of tabs that I want to split into workbooks. See below which works.

However I also want to put a ref tab, (the same one) in each new workbook, along with the series of tabs.

Stumped.

First problem, is that even if I could code it, Excel doesn't support multiple tabs copy, if they contain tables, which mine do.

So that leaves me with how to either create the new book and copy the Ref tab and then the individual tab, or create the individual new workbooks and then copy the ref tab in, in a second routine. Both currently beyond me.

Any help? Much appreciation for any guidance.

Sub MoveSheetsToWorkbooks()
Dim ws As Worksheet, strFilepath As String, pathForSave As String
Dim wb As Workbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False

pathForSave = "mypathtosaveto\"

For Each ws In ActiveWorkbook.Worksheets
If ws.name <> "Index" Then
ws.Activate
savename = ws.name
ws.Copy

ActiveWorkbook.SaveAs pathForSave & savename & ".xlsx"

ActiveWorkbook.Close
End If

Next ws

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[skillilea]

I'd do the copying first, put all the sheets you want to copy in an array then save it. something like this.

Sub CopySheetsToNewWorkbook()
Dim newWorkbook As Workbook
Dim indexSheet As Worksheet
Dim sheetsToCopy As Variant
Dim sheetName As Variant

Set newWorkbook = Workbooks.Add

ThisWorkbook.Sheets("Index").Copy Before:=newWorkbook.Sheets(1) ' this is your index you need in all books
sheetsToCopy = Array("Sheet1", "Sheet2") ' put the sheets you need here

Set indexSheet = newWorkbook.Sheets(1)

' copy
For Each sheetName In sheetsToCopy
ThisWorkbook.Sheets(sheetName).Copy After:=newWorkbook.Sheets(newWorkbook.Sheets.Count)
Next

' now save it to the path...

End Sub

 

[Raddle]

Hello and welcome to the forum (did you join in Jan this year?) and thank you for coming back to me.

I will give this a go but not sure...

I actually don't need the index copied - that is only there as there are c.50 sheets in the source workbook but thank you for thinking about it.

What I need is the ref sheet and then one individual sheet saved to workbook one (named the same as the worksheet).
Then I need another run - the ref sheet and the next individual sheet in the workbook and so on, for about 50 iterations.

However there is another issue I seem to have hit. In trialling this, I manually copied the ref sheet to a new workbook, but darn it, Excel then barfs at the ref to the new sheet in one of the formulas, so I am now thinking I need to remove unwanted sheets ...

Grrr.....

 

[skillilea]

Yep, joined. Been around for a while but, never signed up.

The above won't quite do what you want. Do you have a sample workbook as an example? Might be easier to see it. I'm sure we can figure it out.

Yep, you will get #ref errors but, we just need to update the links. Not a huge deal.

 

[Raddle]

Hey thanks again .. so got round it with what you just suggested (fix the broken ref links)

Dim sFilePath As String
Dim sFileName As String
Dim FromBook As Workbook
Dim ToBook As Workbook

'Specify File Path
sFilePath = "Mypath....."

'Check for back slash
If Right(sFilePath, 1) <> "\" Then
sFilePath = sFilePath & "\"
End If
sFileName = Dir(sFilePath)

Do While Len(sFileName) > 0
Set FromBook = ActiveWorkbook 'these two set lines are genius ... obvious really now one can see them ...
Set ToBook = Workbooks.Open(sFileName)
FromBook.Sheets("tab to copy").Copy Before:=ToBook.Sheets(1)
ToBook.Activate
' re-ran the module to put the refs in here
ToBook.Close SaveChanges:=True

'Set the fileName to the next available file
sFileName = Dir
Loop


End Sub

Thanks to various whose code I have hashed here ...

 

[skillilea]

Glad it worked

 

[Raddle]

One minor follow up on this... when I come to run a second routine against the files in the directory, I sometimes get an error, saying Excel cannot find the file.
If I open the file and Save As the same name (effectively writing over it) the error goes away.
Does anyone know if there is something I should be doing to 'release' the directory etc ..

 

[skillilea]

It may be running to fast for the copy to finish.

Try adding a small delay with this code.
Add it after you copy

Public Sub Wait(Optional fake As String)
' add wait time when copying graphics

  Dim t As Double
  t = Timer
  Do Until Timer - t >= 0.5
    DoEvents
  Loop
End Sub

 

[Raddle]

Yep so this this has helped I think to ensure that the Ref tab gets copied into the file before it closes, so thanks for that.
I mean that is not an Excel feature as such is it, that is dealing with the 'characteristics' of dodge networking, and CPU / RAM grunt.

Either way what is half a sec when one is making the tea anyway right ?!

 

[skillilea]

Absolutely, you can play with the wait time but, usually network and/or connection time is the issue.

I've tried Application.Wait xxx with excel but, that also has some drawbacks.

Glad it helped!