Save sheet in new workbook – VBA

Topic

New Reply

Hi.

I’d like to have a button to save a copy of the current sheet as a seperate workbook, in a specified folder. The file name will have the name of the tab & the current month & year e.g. CNE0709.xls

We’re using a combination of Excel 2003 & 2007.

Here’s what using the record macro gave me;

Sheets(“CNE”).Select
Sheets(“CNE”).Copy
ChDir “F:ISO 18001Legal ComplianceCompliance Audits”
ActiveWorkbook.SaveAs Filename:= _
“F:ISO 18001Legal ComplianceCompliance AuditsCNE.xls”, FileFormat:= _
xlExcel8, Password:=””, WriteResPassword:=””, ReadOnlyRecommended:=False _
, CreateBackup:=False

TIA

Reply | Quote

Replies

Something like:

Code:

ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:= _
"F:ISO 18001Legal ComplianceCompliance Audits" & Activesheet.Name & format(Date, "MMYY") & ".xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

Reply | Quote

Cheers Rory, that works a treat.

Just as a little add on, what could I use to then close the new file?

Reply | Quote

ActiveWorkbook.Close

Reply | Quote

Is there a way to modify this code to copy EACH sheet in a workbook to a separate file, then save the file using the sheet name as the filename?
Thanks!

Reply | Quote

Try this:

Code:

Sub SaveAllSheets()
  Dim wbk As Workbook
  Dim wsh As Worksheet
  Set wbk = ActiveWorkbook
  For Each wsh In wbk.Worksheets
	wsh.Copy
	ActiveWorkbook.Close SaveChanges:=True, Filename:=wsh.Name & ".xls"
  Next wsh
End Sub

Reply | Quote

Hans,
Sorry for the months long delay, but this project got pushed back.
I have the following code established:

Code:

Sub Merit_Sheet_Setup()
'
' Merit_Sheet_Setup Macro
' this macro formats the merit sheets to be pushed out to the program areas.
  Dim wbk As Workbook
  Dim wsh As Worksheet
  Set wbk = ActiveWorkbook
  
  For Each wsh In wbk.Worksheets
' format individual sheets
    wsh.Cells.Select
    wsh.Cells.EntireColumn.AutoFit
    wsh.Range("A5").Select
    Selection.EntireColumn.Insert
    wsh.Columns("A:A").Select
    Selection.ColumnWidth = 1
    wsh.Columns("B:F").Select
    Selection.EntireColumn.Hidden = True
    wsh.Columns("J:L").Select
    Selection.EntireColumn.Hidden = True
    wsh.Range("G2").Select
    ActiveWindow.FreezePanes = True

' lock the sheets leaving the Score & Delete columns editable and copy each sheet to a new workbook
    
    wsh.Columns("O:P").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    wsh.Range("G2").Select
    wsh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="password"
    wsh.EnableSelection = xlUnlockedCells
    wsh.Copy
    ActiveWorkbook.Close SaveChanges:=True, Filename:=wsh.Name & ".xlsx"
  Next wsh
End Sub

But I am finding that it is not walking through the sheets in the workbook. It goes through the first sheet just fine but after saving the first sheet, it is not moving to the second sheet. Any ideas?

Thanks is advance,
Greg

Reply | Quote

I would assume it fails with an error?
Try:

Code:

Sub Merit_Sheet_Setup()
'
' Merit_Sheet_Setup Macro
' this macro formats the merit sheets to be pushed out to the program areas.
  Dim wbk As Workbook
  Dim wsh As Worksheet
  Set wbk = ActiveWorkbook
  
  For Each wsh In wbk.Worksheets
' format individual sheets
    With wsh
        .Activate
        .UsedRange.EntireColumn.AutoFit
        .Range("A5").EntireColumn.Insert
        .Columns("A:A").ColumnWidth = 1
        .Range("B:F,J:L").EntireColumn.Hidden = True
        .Range("G2").Select
        ActiveWindow.FreezePanes = True

' lock the sheets leaving the Score & Delete columns editable and copy each sheet to a new workbook
    
        With .Columns("O:P")
            .Locked = False
            .FormulaHidden = False
        End With
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="password"
        .EnableSelection = xlUnlockedCells
        .Copy
    End With
    ActiveWorkbook.Close SaveChanges:=True, Filename:=wsh.Name & ".xlsx"
  Next wsh
End Sub

Reply | Quote

Thanks Rory! That was a great help

Greg

Reply | Quote