Copy sheets from one workbook to another

[joanna_gr]

Another question! Is there any restriction on how many sheets are allowed to be copied from one workbook to another? I have a workbook with 45 sheets and what I need is to copy the 40 of the them in another existing workbook. I found a macro and tried to use but it usually stops after the 35th sheet. please...

[geekgirlau]

I'm sure someone will correct me if I'm wrong but I seem to remember that the Microsoft Support website is fairly vague about the limitation on the number of sheets permitted in a workbook - it waffled on about memory, resources, phase of moon, whether the month had a "y" in it etc.

My thought would be that you've hit the limit with this workbook. One thing - after you run the macro, have you tried copying the 36th sheet manually? Did it allow you to do it?

[joanna_gr]

I also had the idea that I was not allowed to keep so many sheets in a workbook but I have no problem to keep 45 sheets. I also had no problem to copy all of them to a new workbook manually. I was only stoped by the macro. I was just wondering

[weezy]

How are you trying to copy them? I had no problems copying 40 sheets with the following code (the sheets were blank though). This will copy all the worksheets but can be modified to a certain number depending on how your workbook is set up (easier if all sheets to be copied are together on the left).

Sub CopyToNewBook()
    Dim strName As String
    Dim SheetArray() As Variant
    Dim i As Integer
    Dim sCount As Integer
sCount = ActiveWorkbook.Worksheets.Count
For i = 1 To sCount
        ReDim Preserve SheetArray(i)
        SheetArray(i) = Worksheets(i).Name
    Next i
    Worksheets(SheetArray).Copy
End Sub

HTH,
Weezy

[johnske]

Just a thought...Are you clearing the clipboard directly after each paste? i.e.

Application.CutCopymode = False

on the line after Paste

[joanna_gr]

weezy > This code is not working with my workbook. Please note that all sheets have data and formulas.

Application.CutCopyMode = False

didn't help either.

I tried the following code which is goes fine for the first 36 sheets. And then stops. What I really need is a code which copies ALL 42, except 4, sheets to an existring workbook named "existing.xls" and not create a new one. Any idea?

Sub CopySheets2()
' Turn off screenupdating:
Application.ScreenUpdating = False '
Dim ws As Worksheet, bFirst As Boolean, wbkNew As Workbook
bFirst = True
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "A_datanew", "A_General", "A_ISPACEMONTH", "A_ISPACEYEAR"
'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"
' Turn on screenupdating:
' (happens automaticly after a module is finished):
Application.ScreenUpdating = True
End Sub

[johnske]

Hi Joanna,

I just did this and tried it out with 96 sheets (empty admittedly) but no probs

Option Explicit

Sub CopySheets2()
Application.ScreenUpdating = False
Dim ThisBook As Workbook
Dim WkSht As Worksheet, NewBook As Workbook
Set ThisBook = ThisWorkbook
Set NewBook = Workbooks.Add(xlWBATWorksheet)
For Each WkSht In ThisBook.Worksheets
Select Case WkSht.Name
Case "A_datanew", "A_General", "A_ISPACEMONTH", "A_ISPACEYEAR"
'these are the sheets names which shouldn't be copied
Case Else
WkSht.Copy After:=NewBook.Sheets(NewBook.Sheets.Count)
End Select
Application.CutCopyMode = False
Next WkSht
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Worksheets("Sheet1 (2)").Name = "Sheet1"
NewBook.SaveAs Filename:="TestItOut.xls"
End Sub

HTH
John

EDIT: Sorry Joanna, I was led astray by your "WkbNew" variable. After reading what you'd said before your code I see now you DONT want a new workbook - not to worry, if the previous code worked OK, we can now use this new book for testing for the next bit of code.

Now, make sure the new workbook "TestItOut" is closed and put this new code in the workbook you want to copy from. Make sure both workbooks are in the same folder or on the desktop...

This code will open "TestItOut" (and will give an error if it's already open) and then copy your sheets into "TestItOut". i.e. in MY test, it copied the 96 sheets from the original workbook and added them into "TestItOut" so that "TestItOut" ended up with a total of 192 worksheets - still with no problems:

Sub CopySheets2OtherBook()
Application.ScreenUpdating = False
Dim ThisBook As Workbook
Dim WkSht As Worksheet, OtherBook As Workbook
Set ThisBook = ThisWorkbook
'put TestItOut in the same folder as this one (or both on desktop)
'opens and makes Active "TestItOut"
Application.Workbooks.Open (ThisWorkbook.Path & "\TestItOut.xls")
For Each WkSht In ThisBook.Worksheets
Select Case WkSht.Name
Case "A_datanew", "A_General", "A_ISPACEMONTH", "A_ISPACEYEAR"
'these are the sheets names which shouldn't be copied
Case Else
WkSht.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
End Select
Application.CutCopyMode = False
Next WkSht
ActiveWorkbook.SaveAs Filename:="Test.xls"
End Sub

[joanna_gr]

Perfect. Couldn't work better. I moved about 50 sheets with lots of data and formulas. Thank you soooooooooo much!! I'll reduce my work so much that soon I'll have nothing to do at office... lol.

[johnske]

Not a prob., glad to be able to help