How to VBA to save reports, generated using macros, to specific folders

How to create VBA to save reports, generated using macros, to specific folders

The user has a set of macros to generate multiple reports which works fine.

The user would like to include a VBA script to save the generated reports into specific folders depending on the name of the report that is being generated. When the user generates reports using macros, the files are saved as per the name of the city to the local drive. What is required s to have the macro search up the corresponding folder (matching the name of the report) in the local drive and place it under a folder with the current date. For example, the macro saves all the reports (city names) for the client AFD to D: after which the user has to manually place the files to its respective folders. The user would like for it to search the directory for a folder called AFD > city name > current month > current date > save. There are a total of 25 clients and 175 cities.

Here's the VBA code used to generate the reports:

Code:

Sub RespFilterDenied()
    Dim c As Range
    Dim Rng As Range
    Dim lr As Long
        
        lr = Cells(Rows.Count, "R").End(xlUp).row
        Set Rng = Range("A1:X" & lr)
        
        Range("W1:W" & lr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AM1"), Unique:=True
        
        For Each c In Range([AM2], Cells(Rows.Count, "AM").End(xlUp))
            With Rng
                .AutoFilter
                .AutoFilter field:=23, Criteria1:=c.Value
                .SpecialCells(xlCellTypeVisible).Copy
                Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
                ActiveSheet.Paste
                For Each R In ActiveWindow.RangeSelection.Rows
        R.RowHeight = 36
Next R
            End With
        Next c
        Sheets("Sheet1").Delete
        ActiveWorkbook.Save
        ActiveWorkbook.Close
End Sub

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/149229-vba-to-save-reports-generated-using-macros-to-specific-folders

Solution:

Code:

Sub RespFilterDenied() 
    Dim c As Range 
    Dim Rng As Range 
    Dim lr As Long 
    Dim fn as string
    Dim clientName as string
    Dim cityName as string
     
    lr = Cells(Rows.Count, "R").End(xlUp).row 
    Set Rng = Range("A1:X" & lr) 
     
    Range("W1:W" & lr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AM1"), Unique:=True 
     
    For Each c In Range([AM2], Cells(Rows.Count, "AM").End(xlUp)) 
        With Rng 
            .AutoFilter 
            .AutoFilter field:=23, Criteria1:=c.Value 
            .SpecialCells(xlCellTypeVisible).Copy 
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value 
            ActiveSheet.Paste 
            clientName = Range("E2").value
            cityName = Range("I2").value
            For Each R In ActiveWindow.RangeSelection.Rows 
                R.RowHeight = 36 
            Next R 
        End With 
    Next c 
    Sheets("Sheet1").Delete 
    fn = "D:\" & clientName & "\" & cityName & "\" & format(date,"mmmm") & "\" & replace(date,"/","-") & "\" & cityName & ".xlsx"
    ActiveWorkbook.SaveAs fn, xlWorkbookNormal
    ActiveWorkbook.Close 
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Trunten.