To be honest, I'm really no clearer from your answers, so this is a guess:
Sub BackUps2()
Dim filelist1, filelist2 As Variant
Dim i As Long
Dim filetocopy As String
Dim copysource As String, FileDt As Date
filelist1 = ActiveWorkbook.Sheets("Production Dbs").Range("E1").CurrentRegion.Columns(5).Value
filelist2 = ActiveWorkbook.Sheets("Production Dbs").Range("F1").CurrentRegion.Columns(6).Value
FileDt = Now
dte = Format(FileDt, "yyyy-mm-dd_")
For i = 2 To UBound(filelist1)
fname = Dir$(filelist1(i, 1) & "*.accdb")
While fname <> ""
cFrom = filelist1(i, 1)
cFrom = Left(cFrom, InStrRev(cFrom, "\", , vbTextCompare))
cFrom = cFrom & fname
cTo = filelist2(i, 1)
cTo = Left(cTo, InStrRev(cTo, "\", , vbTextCompare))
cTo = cTo & dte & fname
FileCopy cFrom, cTo
fname = Dir$()
Wend
Next i
End Sub
It could be a lot shorter, but it's still in development.