• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

saving workbook to multiple folders

Y

ysherriff

Member
Hello all.

I have the below vba that creates multiple folders based on a list. now i want a vba code to save worksheet into the multiple folders based on the list.
Code: 
Sub Saveinmultiplefolders()
  Dim xdir As String
  Dim fso
  Dim lstrow As Long
  Dim i As Long
  Set fso = CreateObject("Scripting.FileSystemObject")
  lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  For i = 1 To lstrow

  xdir = "C:\Users\yhs0004\Desktop\Various Files\Folder VBA\" & Range("A" & i).Value
  If Not fso.FolderExists(xdir) Then
  fso.CreateFolder (xdir)
  End If
  Next
  Application.ScreenUpdating = True
End Sub


I have attached the spreadsheet.
 

Attachments

  • save in multiple folders.xls
    88 KB · Views: 17
Last edited by a moderator:
Hello ysherriff, does this work for you.

I added this code and a variation of it to your file

Code: 
'  FileFormats
'  ".csv": FileFormat = 6
'  ".xlsb": FileFormat = 50
'  ".xlsx": FileFormat = 51
'  ".xlsm": FileFormat = 52
'  ".xls": FileFormat = 56
Sub SaveSheetsAsNewBooksByList()
    Dim SheetName As String
    Dim MyFilePath As String
    Dim FileName As String
    Dim ws As Worksheet
    Dim wsN As Worksheet

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

'Add Sheet names here
    For Each ws In Worksheets(Array("XXX", "YYY", "ZZZ"))
    SheetName = ws.Name
    ws.Copy

    MyFilePath = ThisWorkbook.path & "\" & SheetName

    If Len(Dir(MyFilePath, vbDirectory)) = 0 Then
      MkDir MyFilePath
    End If

    With ActiveWorkbook
        'remove all other sheets from new workbook
        For Each wsN In .Worksheets
                If wsN.Index <> 1 Then wsN.Delete
            Next wsN
        '~save book in this folder
        ActiveWorkbook.SaveAs FileName:=MyFilePath & "\" & SheetName & "_" & Format(Now(), "DD-MM-YY hh.mm") & ".xlsx", FileFormat:=51
        ActiveWorkbook.Close SaveChanges:=True
    End With
            
    Next ws


   With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub
 

Attachments

  • save in multiple folders.xls
    101 KB · Views: 19
Last edited:
There are two worksheets in your workbook...which one gets saved? Are we copying the same worksheet into every folder?
 
In the below macro I created, it generates seperate folders based on a list. I want the workbook to be saved in each folder that is created. I have revised the macro but it is not working. It is below. So basically, every time a folder is created, the activeworkbook is saved in that folder and then moves to the next name in the list and the process repeats.

Sub saveinmultiplefolders()
Dim xdir As String
Dim fso
Dim lstrow As Long
Dim i As Long
Dim relativepath As String


Set fso = CreateObject("Scripting.FileSystemObject")
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lstrow
'change the path on the next line where you want to create the folders
xdir = "C:\Users\yhs0004\Desktop\Various Files\Folder VBA\" & Range("A" & i).Value
If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If
relativepath = Thisworkbook.Path "\xdir\" & ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=relativepath
Next
Application.ScreenUpdating = True
End Sub
 
Try this:
Code: 
Sub saveinmultiplefolders()
Dim xDir As String
Dim lstRow As Long
Dim i As Long
Dim relativePath As String

lstRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lstRow
    'change the path on the next line where you want to create the folders
    xDir = "C:\Users\yhs0004\Desktop\Various Files\Folder VBA\" & Range("A" & i).Value
    'Make our new folder if needed
    If Dir(xDir, vbDirectory) = "" Then MkDir (xDir)
   
    relativePath = xDir & "\" & ThisWorkbook.Name
    ThisWorkbook.SaveCopyAs relativePath
Next
Application.ScreenUpdating = True
End Sub

Just curious, why are you making so many copies of the same workbook?
 
Thank you Luke. Each folder represents a different facility. The workbook is a report each facility has fill out for performance evaluation. It is a standardize report. Instead of me copying and pasting into each facility. There are over 200 facilities and it will be tedious and prone for errors if i create each folder manually and then copy the worksheet to the folder.

I really appreciate it. Let me see if this works.
 
Larry,

I am running into a problem and want to know how can i modify the code. the list is located on a sheet in the workbook. If I hide the sheet in the workbook, the code won't run for some reason. It is saying something about directory not found.

Is there a way I can modify the code by doing the following:

1) the list will be on a seperate workbook
2) the template will be on a seperate workbook
3) the code will go through the list, create a folder and save the template into the newly created folder
4) this will repeat until the end of the list

Thank you very much.
 
With VB, you just need to keep track of the Parent objects. Ranges belong to sheets, which belong to workbooks. If you don't specify a parent, VB assumes the active sheet/book is what to use. If things are hidden and/or dealing with multiple items, good idea to define all our parents.

Knowing that, things like this:
Code: 
lstRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

should be changed to:
Code: 
With Workbooks("My Workbook.xls").Worksheets("Sheet1")
lstRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

and possibly change this:
Code: 
ThisWorkbook.SaveCopyAs relativePath
to this:
Code: 
Workbooks("Template Book.xls").SaveCopyAs relativePath
 
Larry,

I am getting a runtime error 53: file not found for this section

If Dir(xdir, vbDirectory) = "" Then MkDir (xdir)

I have attached the file. Can you look at it and see what it is doing. I am learnig VBA and the code is not working. I want the code to work if I hide the "control" sheet.

Thanks for your help.
 

Attachments

  • Market Potential Grid.xls
    97.5 KB · Views: 8
sorry, that was my fault. Need to have a ending slash on the filepath. Macro should be:
Code: 
Sub saveinmultiplefolders()
Dim xdir As String
Dim lstRow As Long
Dim i As Long
Dim relativePath As String



With Workbooks("Market Potential Grid.xls").Worksheets("control")
    lstRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Application.ScreenUpdating = False
For i = 1 To lstRow
    'change the path on the next line where you want to create the folders
    xdir = "C:\Users\yhs0004\Desktop\Various Files\Folder VBA\" & Range("A" & i).Value & "\"
    'Make our new folder if needed
    If Dir(xdir, vbDirectory) = "" Then MkDir (xdir)
   
    relativePath = xdir & ThisWorkbook.Name
    ThisWorkbook.SaveCopyAs relativePath
Next

Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Files were generated succssfully!"
End Sub
 
I am sorry to be a pest Luke. But the same error keeps coming up. The code in red is where the error is located. I hid the worksheet where the list is located and it doesn't like it.the only way this code works is if the worksheet is visible. The error comes up path not found. I will do some more search on the net for this for my education purpose.

If Dir(xdir, vbDirectory) = "" Then MkDir (xdir)

There has to be a way in excel where if the worksheet where the list located is hidden, the code should still work.
 
In this line
xdir = "C:\Users\yhs0004\Desktop\Various Files\Folder VBA\" & Range("A" & i).Value & "\"
is the Range supposed to be from the hidden sheet?? If so, need to specify the parent
xdir = "C:\Users\yhs0004\Desktop\Various Files\Folder VBA\" & Worksheets("control").Range("A" & i).Value & "\"

Also, are all the parent folders already created (Various files, Folder VBA)?
 
No. This is the premise of the code:

I have one workboook with two sheets. The 1st sheet is the control sheet with the list of folders to be created. The 2nd sheet is the report sheet.

1. I want the code to create a folder based on the list in control sheet. Then immediately, save the workbook in the folder.
2. the process will continue until the end of the list in the control sheet.


To make it easier, I can create two seperate macros, where it will create all the folder firsts and then second code to save the workbook into each individual folder. But i thought there was a code where you can do it all in one instead of seperate macros.

I will try your suggestion now.
 
Right...I was asking through if we need to create any of the parent folders, or all the created folders at same level.

C:\Users\yhs0004\Desktop\Various Files\Folder VBA\
We know that at least the Desktop folder exists already. Does the Various Files folder exist? Does Folder VBA exist?
 
Yes. both Various and Folder VBA already exists. They are just path directories. The code should be flexible where if i want to move it to another path it doesn't matter.

I hope that helps.

Also, I just tested the code. It works when hidden but the workbook is not saved in the newly created directory.


so basically the new directory would be

C:\Users\yhs0004\Desktop\Various Files\Folder VBA\created folder name based on list\saved workbook.xls

i hope that helps
 
So, the new folder is getting created, but file is not saved? Very strange.
Here's your macro again, with some Debug lines added. Try stepping through the code (hit F8), and make sure that the correct strings are appearing in the Immediate window.
Code: 
Sub saveinmultiplefolders()
Dim xDir As String
Dim lstRow As Long
Dim i As Long
Dim relativePath As String



With Workbooks("Market Potential Grid.xls").Worksheets("control")
    lstRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Application.ScreenUpdating = False
For i = 1 To lstRow
    'change the path on the next line where you want to create the folders
   xDir = "C:\Users\yhs0004\Desktop\Various Files\Folder VBA\" & Range("A" & i).Value & "\"
   
   'Testing purposes
   Debug.Print "Folder name is: " & xDir
   
    'Make our new folder if needed
   If Dir(xDir, vbDirectory) = "" Then MkDir (xDir)
   
    relativePath = xDir & ThisWorkbook.Name
    'Testing purposes
   Debug.Print "File will be saved as: " & relativePath
    ThisWorkbook.SaveCopyAs relativePath
Next

Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Files were generated succssfully!"
End Sub
 
The new folder is getting created and also the files are created also. The issue is the file is not saved in the new folder directory.

Let me try the new code with debugging to see where the issue lie. I appreciate all your help Larry. Will keep you posted.
 
I apologize Luke. I did not know where i am getting Larry from. Maybe another forum. The file is being saved in this path

C:\Users\yhs0004\Desktop\Various Files\Folder VBA

but it should be saved where the path where the newly created folder was generated. For instance, i ran the macro for the first name on the list and the file path for the created folder is:

C:\Users\yhs0004\Desktop\Various Files\Folder VBA\Gl - Alleghany\exceltemplate.xls

the workbook should be saved where the highlighted red text is. right now it is being saved like this.

C:\Users\yhs0004\Desktop\Various Files\Folder VBA\
 
When you ran the macro, what appeared in the Immediate Window? If you can't see the Immediate Window, press Ctrl+G while in the VBE to see it. There should be some debug messages. I'm looking to see if somehow the variable is not getting stored correctly.
 
Luke M said:
With VB, you just need to keep track of the Parent objects. Ranges belong to sheets, which belong to workbooks. If you don't specify a parent, VB assumes the active sheet/book is what to use. If things are hidden and/or dealing with multiple items, good idea to define all our parents.

Knowing that, things like this:
Code: 
lstRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

should be changed to:
Code: 
With Workbooks("My Workbook.xls").Worksheets("Sheet1")
lstRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

and possibly change this:
Code: 
ThisWorkbook.SaveCopyAs relativePath
to this:
Code: 
Workbooks("Template Book.xls").SaveCopyAs relativePath
Click to expand...


Hi
I am trying create a macro to save the sheets in a folder name "Attachments" saved in the desktop. Currently i have used the below code to separate sheets in the workbook as below,

Code: 
Sub attachments()Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 9
Set ws = Sheets("EmailOutput")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:I1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

After this function i want the code to save the sheets to the desktop folder as individual workbooks with the name of the sheet. Can you help me with the code.

Thanks a lot in advance.
 
You must log in or register to reply here.
Back
Top