How to save each worksheet as a separate file

  • Thread starter Steven M (remove cola to reply)
  • Start date
S

Steven M (remove cola to reply)

I'm having a problem with a program that is supposed to read Excel
files, and one of the problems might be the number of worksheets. The
Excel file has 35 worksheets.

Is there any quick way to save each worksheet as its own separate
file?
 
R

Ron de Bruin

Hi Steven

Try something like this

Sub test()
Dim a As Integer
Dim wb As Workbook
Application.ScreenUpdating = False
For a = 1 To ThisWorkbook.Worksheets.Count
ThisWorkbook.Sheets(a).Copy
Set wb = ActiveWorkbook
wb.SaveAs "C:\" & wb.Sheets(1).Name & ".xls"
wb.Close False
Set wb = Nothing
Next a
Application.ScreenUpdating = True
End Sub
 
S

Steven M (remove cola to reply)

Thanks. It works, if I put it in the "ThisWorkbook" module in the
open spreadsheet, and that solves most of my problem.

But how can I save it in PERSONAL and make it work for other files?
If I put it there, it copies the sheets from that file, not the open
Excel file. (the one with 35 worksheets).

Steven
 
R

Ron de Bruin

Hi Steven

If you want to copy it in your personal.xls then also test if the
Sheet is hidden before you copy it.
You can't copy a hidden sheet

Sub test2()
Dim a As Integer
Dim wb As Workbook
Application.ScreenUpdating = False
For a = 1 To ActiveWorkbook.Worksheets.Count
If ActiveWorkbook.Sheets(a).Visible = True Then
ThisWorkbook.Sheets(a).Copy
Set wb = ActiveWorkbook
wb.SaveAs "C:\" & wb.Sheets(1).Name & ".xls"
wb.Close False
Set wb = Nothing
End If
Next a
Application.ScreenUpdating = True
End Sub
 
R

Ron de Bruin

Hi Steven

I forgot to change one Thisworkbook to ActiveWorkbook I see


--
Regards Ron de Bruin
http://www.rondebruin.nl


Ron de Bruin said:
Hi Steven

If you want to copy it in your personal.xls then also test if the
Sheet is hidden before you copy it.
You can't copy a hidden sheet

Sub test2()
Dim a As Integer
Dim wb As Workbook
Application.ScreenUpdating = False
For a = 1 To ActiveWorkbook.Worksheets.Count
If ActiveWorkbook.Sheets(a).Visible = True Then
ThisWorkbook.Sheets(a).Copy
Set wb = ActiveWorkbook
wb.SaveAs "C:\" & wb.Sheets(1).Name & ".xls"
wb.Close False
Set wb = Nothing
End If
Next a
Application.ScreenUpdating = True
End Sub
Click to expand...
 
Top