ExcelのVBAで指定した複数ファイルを指定したフォルダにコピーしたい

前提・実現したいこと

EXCELのVBA(マクロ)で指定のフォルダ（A）の、複数の指定のExcelファイル（b.xlsx, g.xlsx, m.xlsm）をリネーム（元ファイル名+元ファイル更新日時）して別の指定したフォルダにコピーする。
そのようなVBAは可能でしょうか

発生している問題・エラーメッセージ

想定としては下記を想定しています。
B2セル：元ファイル格納ディレクトリ
C2セル：コピー先ディレクトリ
C4セル：C4セルから空白行まで繰り返しコピー
調べ方が悪いのか一つのファイルコピーしかソースが見つかっておりません

該当のソースコード

Sub test()
Dim objFileSys
Dim strFilePathFrom
Dim strFilePathTo

'ファイルシステムを扱うオブジェクトを作成
Set objFileSys = CreateObject("Scripting.FileSystemObject")
 
'コピー元のファイルのパスを指定
strFilePathFrom = "c:\temp\コピー元.txt"
strFilePathTo = "c:\temp\コピー先.txt"
 
'エラー発生時にも処理を続行するよう設定
On Error Resume Next
 
'ファイルを上書きコピー
Call objFileSys.CopyFile(strFilePathFrom, strFilePathTo)
 
'元ファイルが無いなど、エラーになった場合の処理
If Err.Number <> 0 Then
  'ここにエラー時の処理を記述
  MsgBox "ファイルコピー時にエラーが発生しました。" & vbNewLine & _
         "エラー番号：" & Err.Number & vbNewLine & _
         "エラー詳細：" & Err.Description
  
  'エラー情報をクリアする。
  Err.Clear
End If
 
'「On Error Resume Next」を解除
On Error GoTo 0
 
Set objFileSys = Nothing

End Sub

行動規範の内容に同意します

回答1件

VBA
1Dim ws As Worksheet, lastRow As Long
2Dim i As Long, f, fn As String, updTime As Date
3
4Set ws = ActiveSheet
5lastRow = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
6With objFileSys
7    For i = 4 To lastRow
8        Set f = .GetFile(.BuildPath(ws.Range("B2").Value, ws.Range("C" & i).Value))
9        updTime = f.DateLastModified
10        fn = .GetBaseName(f.Path) & Format(updTime, "_yyyymmdd.") & .GetExtensionName(f.Path)
11        f.Copy .BuildPath(ws.Range("C2").Value, fn)
12    Next
13End With