Results 1 to 9 of 9
  1. #1
    4 Star Lounger
    Join Date
    May 2001
    Location
    Oxfordshire
    Posts
    456
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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 18001\Legal Compliance\Compliance Audits"
    ActiveWorkbook.SaveAs Filename:= _
    "F:\ISO 18001\Legal Compliance\Compliance Audits\CNE.xls", FileFormat:= _
    xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
    , CreateBackup:=False


    TIA

  2. #2
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts
    Something like:
    Code:
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:= _
    "F:\ISO 18001\Legal Compliance\Compliance Audits\" & Activesheet.Name & format(Date, "MMYY") & ".xls", FileFormat:= _
    xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
    , CreateBackup:=False
    Regards,
    Rory

    Microsoft MVP - Excel

  3. #3
    4 Star Lounger
    Join Date
    May 2001
    Location
    Oxfordshire
    Posts
    456
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Cheers Rory, that works a treat.

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

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    ActiveWorkbook.Close

  5. #5
    Star Lounger
    Join Date
    Aug 2001
    Location
    Bloomington, Indiana, USA
    Posts
    75
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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!
    Greg <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15>

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    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

  7. #7
    Star Lounger
    Join Date
    Aug 2001
    Location
    Bloomington, Indiana, USA
    Posts
    75
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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
    Greg <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15>

  8. #8
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts
    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
    Regards,
    Rory

    Microsoft MVP - Excel

  9. #9
    Star Lounger
    Join Date
    Aug 2001
    Location
    Bloomington, Indiana, USA
    Posts
    75
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Thanks Rory! That was a great help

    Greg
    Greg <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15>

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •