VBA-根据标识符，在目录中动态打开工作簿并从每个工作簿粘贴值？

Question

我在目录中有几百个excel文件，每个文件的名称中都有一个唯一的标识符，名称分别为103、208c，231a等。标识符包含在工作簿的一栏中，其中包含代码。基于这些标识符，我试图动态打开包含文本字符串的工作簿，并将单个单元格粘贴到其工作簿标识符旁边。

我试图使它在下面的单个情况下起作用，但是在动态文件打开宏结束之后，而不是选择值并将其粘贴。如果有人对如何解决该问题或如何将此代码从单例转换为基于动态/循环的方法提出任何建议，我将不胜感激。我对VBA编码比较陌生。通常只需要很少阅读/通过现有代码即可。

Option Explicit
Sub Process()
On Error Resume Next
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

Dim sFound As String, fPath As String
Dim BaseFile As Workbook
Dim TestSheet As Worksheet
Dim WB1 As Workbook
Set TestSheet = ThisWorkbook.Sheets("TestSheet")
Set BaseFile = ThisWorkbook

fPath = "\\WhateverDirectory\"
sFound = Dir(fPath & "*231a*") '231a should be values in column B row 4 on in the TestSheet
If sFound <> "" Then
    Set WB1 = Workbooks.Open(fPath & sFound)
    WB1.Sheets("RCM").Range("D6").Copy
    BaseFile.Activate
    TestSheet.Range("C4").PasteSpecial xlPasteValues
End If