VBA代码查找一个文件夹中的文件组，总是以相同的顺序，并将特定的单元格粘贴到主文件中

Question

我有一个excel vba问题，我试图解决，并在搜索互联网和许多论坛后，我有不成功。

问题1：如果a2中的单元格显示Brian Johnson（甚至是BrianJohnson），是否可以打开BrianJohnson.xlsx文件？将会有大约30个文件，我想这样打开，这样主文件可以在其他工作表中使用单元格引用，而且事情不会变得棘手。

 Sub aaron_gather() 
' 
' aaron_gather Macro 
Dim bestandopen 
Application.ScreenUpdating = False 
On Error Resume Next 'if there are no 12 sheets 
bestandopen = Dir("H:\Americorps\*") 
    Do Until bestandopen = "" 
     If bestandopen = "" Then Exit Do 
     If Not bestandopen = "Americorps Master Sheet 1.xlsm" Then 
     Workbooks.Open "H:\Americorps\" & bestandopen 
    ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1) = ActiveWorkbook.Name 
     For i = 1 To 12 
      ThisWorkbook.Sheets("Total Hours").Cells(Rows.Count, 1).End(xlUp).Offset(, i) = ActiveWorkbook.Sheets(i).Range("E43") 
     Next i 
     ThisWorkbook.Sheets("Total Hours").Columns.AutoFit 
    Workbooks(bestandopen).Close 
End If 
     bestandopen = Dir 
    Loop 
End Sub 

Answer 1

编译，未经测试...

Sub Test() 

Const FLDR_PATH As String = "H:\Americorps\" 
Dim c As Range, wbSource As Workbook 
Dim shtTH As Worksheet, i As Integer 
Dim cellTH As Range, filepath As String 

    Set shtTH = ThisWorkbook.Sheets("Total Hours") 

    For Each c In shtTH.Range("A2:A10") 'are names on total hours sheet? 

     filepath = FLDR_PATH & Replace(c.Value, " ", "") & ".xlsx" 

     If Len(Dir(filepath, vbNormal)) > 0 Then 
      c.Font.ColorIndex = xlAutomatic 
      Set wbSource = Workbooks.Open(filepath, , True) 'readonly 

      For i = 1 To 12 
       'copy values to same row as filename source 
       c.Offset(0, i).Value = _ 
        wbSource.Sheets(i).Range("E43").Value 
      Next i 

      wbSource.Close False 
     Else 
      c.Font.Color = vbRed 'file not found 
     End If 

    Next c 

End Sub