I'm trying to figure out a way to modify my macro so it can use another Workbook with a list of file locations to save in the respective location. This macro below splits a large report file into separate files based on common values in column A. These values are location codes that are also in column A in my other Workbook containing the file folder locations in column C.
*
I receive these reports daily and have to manually put each file into their dropbox locations, which I imagine can be done easily with a little more code. I'm stumped. I've tried another while loop and if statements. Ideally, I will open my report file, open the macro file, open the dropbox file, run the macro and the file will split up and go to their respective locations.
*
*
Sub DistributeRows()
Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long
Dim SaveName As Range
***
*** Set wsData = Worksheets("sps_current_fte_report")
*** Set wsCrit = Worksheets.Add
***
*** LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
***
*** wsData.Range("A1:A" & LastRow).AdvancedFilter action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
***
*** Set rngCrit = wsCrit.Range("A2")
*** While rngCrit.Value <> ""
******* Set wsNew = Worksheets.Add
******* wsData.Range("A1:L" & LastRow).AdvancedFilter action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
******* wsNew.Name = rngCrit
******* wsNew.Copy
******* Set wbNew = ActiveWorkbook
******* Set SaveName = wsNew.Range("I2")
******* SaveName = Replace(SaveName, " ", "", 1, 75)
******* wbNew.SaveAs ThisWorkbook.Path & "\" & SaveName & " " & Format$(Date, "mm-dd-yyyy") & ".xlsx"
******* wbNew.Close SaveChanges:=True
******* Application.DisplayAlerts = False
******* wsNew.Delete
******* rngCrit.EntireRow.Delete
******* Set rngCrit = wsCrit.Range("A2")
*** Wend
***
*** wsCrit.Delete
*** Application.DisplayAlerts = True
End Sub
Bookmarks