Create a workbook from every worksheet in your workbook

[vicky]

i have a workbook name test1 which contain 3 sheets named
"aa","bb","cc" .now i need a macro which loop thru test1 workbook and
should create 3 new workbooks with name "aa" ,"bb", "cc" and should
contain data present in their respective sheets.

 

[Jarek Kujawa]

Sub cus()
For Each Sheet In ThisWorkbook.Sheets
Sheet.Copy
Next
End Sub

 

[Per Jessen]

Hi

This should do it:

Sub CopyShToNewWb()

Dim NewWb As Workbook
For Each sh In ThisWorkbook.Sheets
shName = sh.Name
sh.Copy
Set NewWb = ActiveWorkbook
NewWb.SaveAs Filename:=shName
NewWb.Close
Next
End Sub

Regards,
Per

 

[Jarek Kujawa]

ooop!

sorry, forgot about saving new workbooks

Sub cus()
For Each Sheet In ThisWorkbook.Sheets
Sheet.Copy
With ActiveWorkbook
.SaveAs (Sheet.Name)
.Close
End With
Next
End Sub

 

[vicky]

thanku a lot ppl.
but i have a another issue . i want to save the newly created
workbooks in thisworkbook path .

 

[vicky]

hey got it . chdir thisworkbook.path

 

[Gord Dibben]

Sub Make_New_Books()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In ActiveWorkbook.Worksheets
w.Copy
With ActiveWorkbook
.SaveAs FileName:=ActiveWorkbook.Path _
& "\" & w.Name & ".xlsx"
.Close
End With
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Gord Dibben MS Excel MVP

 

[Ron de Bruin]

See also
http://www.rondebruin.nl/copy6.htm