Duplicate Files in Different Folder

[Howdy1]

Hello,

I am trying to find a way to duplicate the files that I need to create each day in different folder. For example, I have 2 files located in the following path:

1) X:\Price Files\CME\Price_Upload 2022-05-18.xls
2) X:\Price Files\ICE\CL_Price_Upload 2022-05-18.xls

I need to make a duplicate file for each file and then rename it to the following name in the same path:
1) X:\Price Files\CME\Price_Upload 2022-05-19.xls
2) X:\Price Files\ICE\CL_Price_Upload 2022-05-19.xls

Currently, I have to manually go to the file and click on the file and then make a copy and then rename it. I tried to run the macro from Excel to try to record the steps in a Excel workbook but it didn't seem to record. I don't know what I did wrong.. Any help is greatly appreciated!

Thank you a lot!!!

 

[LazyBug]

Hello!

If you need the new file names with today date, try this:

Sub RenameFiles1()
Dim i%, arrFiles(), FolderName$, FileName$, FileDate, NewFileDate
Application.ScreenUpdating = False

    FolderName = "C:\YOUR\PATH\" 'amend to real path to files, don't remember the final backslash
   
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show = 0 Then Exit Sub
        ReDim arrFiles(1 To .SelectedItems.Count)
            For i = 1 To .SelectedItems.Count
                arrFiles(i) = .SelectedItems(i)
            Next i
    End With

For i = 1 To UBound(arrFiles)
        Workbooks.Open arrFiles(i)
        FileName = Split(ActiveWorkbook.Name)(0) 'get file name without date
        ActiveWorkbook.SaveCopyAs FolderName & FileName & " " & Format(Now, "YYYY-MM-DD") & ".xls" 'save copy of file with today date
        ActiveWorkbook.Close 0 'close file without save
    Next i
   
End Sub

If you need the new file names with date in the old ones plus 1 day, use another code:

Sub RenameFiles2()
Dim i%, arrFiles(), FolderName$, FileName$, FileDate, NewFileDate
Dim dFileDate, sNewFileDate
Application.ScreenUpdating = False

    FolderName = "C:\YOUR\PATH\" 'amend to real path to files, don't remember the final backslash
   
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show = 0 Then Exit Sub
        ReDim arrFiles(1 To .SelectedItems.Count)
            For i = 1 To .SelectedItems.Count
                arrFiles(i) = .SelectedItems(i)
            Next i
    End With

    For i = 1 To UBound(arrFiles)
        Workbooks.Open arrFiles(i)
            FileName = Split(ActiveWorkbook.Name)(0)
           
            FileDate = Split(ActiveWorkbook.Name)(1)
            FileDate = Left(FileDate, InStrRev(FileDate, ".") - 1)
            dFileDate = CDate(FileDate)

            NewFileDate = DateAdd("y", 1, dFileDate)
            sNewFileDate = CStr(NewFileDate)
           
            ActiveWorkbook.SaveCopyAs FolderName & FileName & " " & Format(sNewFileDate, "YYYY-MM-DD") & ".xls"
            ActiveWorkbook.Close 0
    Next i
   
End Sub