Macro / VBA to save worksheets to specific folders

[peterman25]

I am working with a macro that looks at a workbook and then saves the individual worksheets to their respective folders. What I am trying to do and what I can't seem to get figured out is saving the worksheets to another level in the file path structure that is the a date folder - mm-yy.

So, workbook.xlsx has multiple worksheets for departments. My goal is to automate the distribution of the worksheets as reports to their respective folders on the network in their appropriate date folder. Save worksheet to N:\accounting\mgmt reports\(worksheet name)\(year)\mm-yy\(worksheet name) "report description .xlsx".

Where N:\accounting\mgmt reports\(worksheet name)\(year)\mm-yy is a folder structure that already exists.

Is this even possible? Thanks for any input.

Existing macro:

Public Sub SplitFile()
Const dstTopLevelPath As String = "N:\Accounting\Acctg\Mgmt Reports\Save Test"
Dim dstFolder As String
Dim dstFilename As String
Dim dstWB As Workbook
Dim dstWS As Worksheet
Dim srcWB As Workbook
Dim srcWS As Worksheet
Dim Agency As String



'Ensure the destination path exists
If Dir(dstTopLevelPath, vbDirectory) = "" Then
MsgBox dstTopLevelPath & " doesn't exist - please create it before running this macro"
End
End If


Set srcWB = ActiveWorkbook


For Each srcWS In srcWB.Worksheets
'Get the Agency name
'(use this line if the Agency name is in cell A2 of each worksheet)
Agency = srcWS.Range("A2").Value


'(use this line if the Agency name is the actual worksheet name)
'Agency = srcWS.Name

'Create the destination path
dstFolder = dstTopLevelPath & "" & Agency


'Create the destination file name
'(use this line if you want the new workbooks to have a name equal to the agency name)
dstFilename = dstFolder & "" & Agency & " trendIS 0718.xlsx"


'(use this line if you want the new workbooks to have the same name as your existing workbook)
'(Note: If your existing workbook is called "xyz.xlsm", the new workbooks will have a ".xlsm"
' extension, even though there won't be any macros in them.)
'dstFilename = dstFolder & "" & srcWB.Name


'(use this line if you want the new workbooks to have a fixed name)
'dstFilename = dstFolder & "\data.xlsx"


'Create a new workbook
Set dstWB = Workbooks.Add


'Copy the current sheet to the new workbook
srcWS.Copy Before:=dstWB.Sheets(1)


'Get rid of any sheets automatically created in the new workbook ("Sheet1", "Sheet2", etc)
For Each dstWS In dstWB.Worksheets
If dstWS.Name <> srcWS.Name Then
Application.DisplayAlerts = False
dstWS.Delete
Application.DisplayAlerts = True
End If
Next


'Ensure the new location exists, and create it if it doesn't
If Dir(dstFolder, vbDirectory) = "" Then
MkDir dstFolder
End If


'Save the new workbook to the required location
dstWB.SaveAs dstFilename


'Close the new workbook
dstWB.Close


Next


MsgBox "Finished"
End Sub

 

[John_w]

Assuming year and mm-yy are the current year and month try this:

dstFilename = "N:\accounting\mgmt reports\" & srcWS.Name & "\" & Format(Date, "yyyy") & "\" & Format(Date, "mm-yy") & "\" & srcWS.Name & " report description.xlsx"

Not clear if ( and ) are part of the path; if so just insert them where required in the above string.

 

[JLGWhiz]

Since your date will change monthly based on your post, you would have to create a new directory each month for the files saved that for period. You would use the MkDir function to do that.
Example:

Dim fPath As String
MkDir "N:\accounting\mgmt reports\(worksheet name)\" & Format(Date, "yyyy") & "\" & Format(Date, "mm-yy")
fPath = "N:\accounting\mgmt reports\(worksheet name)\" & Format(Date, "yyyy") & "\" & Format(Date, "mm-yy")

Then you can use the fPath variable as your SaveAs path.