Cutting up Workbooks

Posted by Donna on June 06, 2000 7:52 AM

Can you help?

I need a VBA to chop up my Workbook.

I have over 100 Sheets and I need them to only have 10 Sheets per Workbook.

So I persume I need it to count the 1st 10 and move them to a new Workbook, then the next 10(Whilst Saving them Automatically and name them automatically eg Orion1 then Orion2.).

I'm quite new at this so any help would be much appreciated.

Donna.

Posted by Donna on June 13, 0100 1:55 AM

An ode

RedGator.

Very poetic ode of Free Vs Fee. However the fee is not me, so alas my Workbooks en mass, must stay as they are and I'll endevour by far to do it myself.

But hey,

Thanks..Donna

Posted by bob on June 07, 0100 6:38 AM

If there is only 100 sheets why don't you just click on the first then go over ten sheets. Hold down shift click on the tenths therefore you have ten sheets highlighted. Right click on it and click move or copy then move them to a new workbook. It will take a lot less time then writing a macro will.

Posted by Donna on June 07, 0100 7:54 AM

Unfortunatly I have a few workbooks like the one mentioned and I rather trust excel than myself to move copius amounts of sheets about.

Thank you for the advice though.

Donna

Posted by RedGator on June 12, 0100 9:33 AM

Donna,
Please email me if you are interested in code to do this task. I would love to do it for a tiny fee. If you have multiple workbooks, it would be worth it. I would do it for free, but right now I don't have time for free. I have the idea of how it will work so let me know.

Posted by Ryan on June 13, 0100 8:55 PM

Heres your code

This will take ten sheets, add a new workbook based on the name of the current workbook
' and add a number to the end of it, i.e. 1,2,3. This will keep looping until there are
' less then 10 sheets in the active folder. Put this in a module, and run it when
' the active workbook is one of the ones with a 100 (or so) sheets. I tested using a
' workbook named Orion w/ 23 sheets. It made two files, Orion1 and Orion2, and left 3
' sheets left in the original Orion. I made this in XL2000, but should work w/ 97!
' I put in two additional lines for you to change if you would like. The line with
' Path = xxx, you can change to a particular place you want the files to go, or else
' They will go to your default location. If you change this you need to use the
' NewBook.SaveAs line that has path in it and delete the other one. I think i've
' covered it all. Hope this helps. Let me know.
'
' Ryan

Sub CleanBooks()

Dim NewBook As Workbook
Dim x As Integer
Dim ThisBook As String
Application.ScreenUpdating = False
x = 0

' Path = xxx
ThisBook = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
Do While Sheets.Count >= 10
x = x + 1

Sheets(Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)).Move
Set NewBook = ActiveWorkbook
' NewBook.SaveAs FileName:=Path & ThisBook & x
NewBook.SaveAs Filename:=ThisBook & x
NewBook.Close
Loop
Application.ScreenUpdating = True

End Sub