Previous Topic Next Topic

VBA 2010 Saving workshts-workbks new file

Closed
whitepanther - Aug 8, 2011 at 05:06 PM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Aug 9, 2011 at 11:56 AM
Hiya,

I've found a fabulous bit of code that saves the individual worksheets as individual workbooks. It works brilliantly and I'm just wondering if there is a way to tweek it to do one more thing. Here's the code:


'Saving Individual worksheets as 97-2003 workbooks

Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set OldBook = Workbooks(ActiveWorkbook.Name)

Application.DisplayAlerts = False

For Each sh In OldBook.Worksheets
If sh.Visible = True Then
sh.Copy
ActiveWorkbook.SaveAs Filename:=OldBook.Path & "\" & sh.Name & "", FileFormat:=xlWorkbookNormal
ActiveWorkbook.Close


End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Application.DisplayAlerts = True

There are a few worksheets that I would like to be saved to a specific folder which I need to create called 'Printed'. I'm wondering if the above code can be adapted to create that new folder and save these specific workbooks to that folder. Or perhaps rather than adapting this code it might be easier to write a code to create the the new folder and move the specified files after they've been saved by the above macro...?
Related:

1 response

Answer 1 / 1
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Aug 9, 2011 at 11:56 AM
How would one can say what sheet goes where. Presuming you know where, here is a sample code. The code would make use of a function MakeMultiStepDirectory. See the comments. You would have to download from there as no reason to reinvent the wheel
In the code below, idea is 


Sub test() 
   'Saving Individual worksheets as 97-2003 workbooks 
    
   Dim NewBook             As Workbook 
   Dim OldBook             As Workbook 
   Dim sh                  As Worksheet 
   Dim sPrintPath          As String 
   Dim sOldPath            As String 
   Dim sSavePath           As String 
    
   Application.ScreenUpdating = False 
   Application.Calculation = xlCalculationManual 
    
   Set OldBook = Workbooks(ActiveWorkbook.Name) 
   sOldPath = OldBook.Path 
    
   sPrintPath = sOldPath & "\print\" 
    
   'the MakeMultiStepDirectory function can be found at (fix spaces) 
   'htt p: / / ww w.cpearson.com/excel/MakeDirMulti.aspx 
   Call MakeMultiStepDirectory(sPrintPath) 

   Application.DisplayAlerts = False 
    
   For Each sh In OldBook.Worksheets 
      If sh.Visible = True _ 
      Then 
         Select Case sh.Name 
            Case "Sheet1", "Sheet2", "Sheet3" 
               sSavePath = sPrintPath 
            Case Else 
               sSavePath = sOldPath 
         End Select 
         sh.Copy 
         ActiveWorkbook.SaveAs Filename:=sSavePath & "\" & sh.Name & "", FileFormat:=xlWorkbookNormal 
         ActiveWorkbook.Close 
      End If 
   Next 
    
   Application.ScreenUpdating = True 
   Application.Calculation = xlCalculationAutomatic 
    
   Application.DisplayAlerts = True 

End Sub
0