Moving multiple worksheets as separate files

[Poli]

I have an excel file that someone put 100 or more sheets in the file. I need
to know how I can extract all the worksheets at the same time as separate
files that I can name maybe file1.xlsx, file2,xlsx etc.

Right now I have to move or copy each sheet one at a time and that is slow.

Thank you in advance for your help.

Pauline Moreno

 

[Gord Dibben]

Sub Make_New_Books_Increment()
Dim wks As Worksheet
Dim lng As Long
lng = 1
For Each wks In ActiveWorkbook.Worksheets
wks.Copy
With ActiveWorkbook
.SaveAs FileName:="C:\folder" _
& "\File" & lng & ".xlsx"
.Close
End With
lng = lng + 1
Next wks
End Sub

Edit the path and folder to your choice.

If the current sheets have unique names you may want to save as that name
rather than File1, File2

Sub Make_New_Books_ShtName()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In ActiveWorkbook.Worksheets
w.Copy
With ActiveWorkbook
.SaveAs FileName:="C:\Folder" _
& "\" & 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 this example
http://www.rondebruin.nl/copy6.htm

 

[Poli]

Thank you so much for your help. Everything worked out just fine.

Poli

 

[Gord Dibben]

Good to hear

Thanks for the feedback

Gord

Thank you so much for your help. Everything worked out just fine.

Poli