These subroutines work in tandem to copy all files and subfolders from FromPath to ToPath, which would typically be listed in an Excel spreadsheet. FromPath and ToPath must both contain strings of the file paths. These strings may be constructed via formula (e.g., in case the file path contains dates).The sub also requires a log worksheet so tha…

vbaSaveFiles

Public Sub Copy_Folder(ByVal FromPath As String, ByVal ToPath As String, ByRef LogSheet As Worksheet, ByVal i As Integer)

'Note: If ToPath already exists it will overwrite existing files in this folder
'if ToPath does not exist it will be made for you.
    Dim FSO As Object

    'Trim the paths just in case the user adds the \ at the end of the path
    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    'Checks to see if the FromPath exists; if not, the sub exits and a message is sent to the log worksheet
    If FSO.FolderExists(FromPath) = False Then
        LogSheet.Cells(i, 1).Value = (FromPath & " doesn't exist")
        Exit Sub
    End If
    
    'Check that the ToPath exists; if not, it creates it; if yes, then make the path
    If FSO.FolderExists(Worksheets("Main").Cells(2, 7).Value & "\" & Worksheets("Main").Cells(4, 5).Value & "\") = True Then
        If FSO.FolderExists(ToPath) = False Then
            MkDir ToPath
        Else
            Exit Sub
        End If
    Else
        MkDir Worksheets("Main").Cells(2, 7).Value & "\" & Worksheets("Main").Cells(4, 5).Value & "\"
        MkDir ToPath
    End If

    FSO.CopyFolder Source:=FromPath, Destination:=ToPath

End Sub

Public Sub SaveOffFiles()
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Main")
    
    Dim strFrom As String
    Dim strTo As String
    
    Dim i As Integer
    
    Application.Calculate
    
    wb.Worksheets("Log").Range("A2:A12").Cells.Clear
    
    ws.Range("A2:A12").ClearContents
    ws.Range("A1").Select
    
    For i = 2 To 12
        strFrom = ws.Cells(i, 3).Value
        strTo = ws.Cells(i, 4).Value
        Call Copy_Folder(strFrom, strTo, wb.Worksheets("Log"), i)
        'Color the cells in col 1 of the Main sheet to indicate success or fail
        If wb.Worksheets("Log").Cells(i, 1).Value = "" Then
            ws.Cells(i, 1).Value = "GOOD"
        Else
            ws.Cells(i, 1).Value = "CHECK"
        End If
    Next i
    
End Sub