code to turn worksheets into workbooks???

lietuvis91

New Member
Joined
Nov 14, 2005
Messages
8
hey all,
I have a workbook w/ 278 worksheets in it and was asked to separate the worksheets into individual workbooks. I can drag and drop each one until my hand falls off, or maybe someone here knows a better way to automate this. Each new workbook should be named after the worksheet it's created from. I'm not afraid to tamper with code, so all suggestions welcome.
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Barrie Davidson

MrExcel MVP
Joined
Feb 10, 2002
Messages
2,330
Welcome to the Board!

You can try this code.

Code:
Sub CreateWorkbooks()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    ws.Copy
    ActiveWorkbook.SaveAs ws.Name & ".xls"
    ActiveWorkbook.Close
Next ws
End Sub

It will save each sheet to the active directory.

Hope this helps.
 

lietuvis91

New Member
Joined
Nov 14, 2005
Messages
8
is there a way to alphabetically sort the worksheets? and how do i run this code ???
 

Barrie Davidson

MrExcel MVP
Joined
Feb 10, 2002
Messages
2,330
lietuvis91 said:
is there a way to alphabetically sort the worksheets?

Try this instead:
Code:
Sub CreateWorkbooks()
Dim ws As Worksheet
Dim prevws As Worksheet
Dim i As Long

For Each ws In ActiveWorkbook.Worksheets
    i = i + 1
    If i <> 1 Then
        If ws.Name < prevws.Name Then
            ws.Move Before:=prevws
        End If
    End If
    ws.Copy
    ActiveWorkbook.SaveAs ws.Name & ".xls"
    ActiveWorkbook.Close
    Set prevws = ws
Next ws
End Sub

lietuvis91 said:
and how do i run this code ???

Make sure the workbooks with 278 worksheets is the active workbook, the code will take care of the rest. Or do you mean that you don't know where to put the code and how to access it?
 

lietuvis91

New Member
Joined
Nov 14, 2005
Messages
8

ADVERTISEMENT

that's what I mean, I'm not sure where to put the code and how to run it. Thank you so much for your help though, you rock!
...so how do i run this code?
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Barrie,
your code is not sorting everything
to my sense you need more code
something like
Code:
Sub alph()
'unknown author
Dim sht As Worksheet
Dim Shts()
ReDim Shts(ThisWorkbook.Worksheets.Count)
i = LBound(Shts)
For Each sht In ThisWorkbook.Worksheets
    Shts(i) = sht.Name
    i = i + 1
Next sht
Bubblesort Shts
For i = LBound(Shts) + 1 To UBound(Shts)
Worksheets(Shts(i)).Move After:=Worksheets(ThisWorkbook.Worksheets.Count)
Next i

End Sub

Sub Bubblesort(sht())
Dim tmp
For i = LBound(sht) To UBound(sht)
    For j = i To UBound(sht)
    If sht(i) > sht(j) Then
        tmp = sht(i)
        sht(i) = sht(j)
        sht(j) = tmp
    End If
    Next j
Next i
End Sub

to paste the code
start the Visual Basic Editor (via Menu Tools, Macro or press ALT+F11).
On the Insert menu in the VBE, click Module. (if necessary)
In the module (the white area at the right), paste the code

to run the code
click anywhere in the code and hit function key F5
or
via Excel menu: Tools / Macro / Macros (or hit Alt+F8)


kind regards,
Erik
 

lietuvis91

New Member
Joined
Nov 14, 2005
Messages
8

ADVERTISEMENT

You guys are just AWESOME! thanks sooo mUch!!!! it worked flawlesly!
 

Watch MrExcel Video

Forum statistics

Threads
1,118,386
Messages
5,571,829
Members
412,421
Latest member
grace_abar
Top