code to turn worksheets into workbooks???

[lietuvis91]

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.

 

[Barrie Davidson]

Welcome to the Board!

You can try this 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]

is there a way to alphabetically sort the worksheets? and how do i run this code ???

 

[Barrie Davidson]

is there a way to alphabetically sort the worksheets?

Try this instead:

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

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]

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]

Barrie,
your code is not sorting everything
to my sense you need more code
something like

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]

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

 

[Barrie Davidson]

Barrie,
your code is not sorting everything
to my sense you need more code

Thanks for covering me Erik!! :wink:

 

[erik.van.geit]

Thanks for covering me Erik!!

unknown sources covered me too :wink:
couldn't find the author