Excel VBA 宏以匹配根文件夹中工作簿中的单元格值，然后复制特定单元格

Question

Picture above is the master workbook. Can anyone help me to write the vba so it will find workbooks throughout the root folder (eg C:\\Work\\2017) that match with the account number and copy the B9 and E9 cells to the master cell. The 2nd picture is a system generated workbook with random name (eg export!-097a0sdk.xls), that's why I need a shortcut to make this task easier.

This is the result I expected by using the code

This is the excel generated by system

Thank you

Answer 1

If I understood correctly then the following will loop through a given directory and it will open and check each file for the required information, if found, it will add the values to your Master workbook.

Note : This code will not open a file if it has "Master" in its filename.

Sub LoopThroughFolder()
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim wb As Workbook
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim myFile As File
Dim AccNumber As String
Dim LastRow As Long, i As Long
Dim sPath As String
sPath = "C:\Work\2017"

LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Application.DisplayAlerts = False
'do not display alerts
Set myFolder = FSO.GetFolder(sPath) 'set the root folder
    For Each myFile In myFolder.Files 'for each file in the folder
        If InStr(myFile.Name, "Master") = 0 Then
        'if file to open does not have "Master" in it's name then
            Set wb = Workbooks.Open(myFile.Path) 'open the file
            AccNumber = wb.Sheets(1).Range("B2") 'check for account number on first Sheet
            For i = 1 To LastRow 'loop through current Sheet to check if we have a match for the account number
                If ws.Cells(i, 1) = AccNumber Then 'if match
                ws.Cells(i, 2) = wb.Sheets(1).Range("B9") 'pass the values from the required range
                ws.Cells(i, 3) = wb.Sheets(1).Range("E9")
                End If
            Next i
            wb.Close False 'close and do not save changes
            Set wb = Nothing
        End If
    Next
Application.DisplayAlerts = True
End Sub

Also you might have to set a reference to the relevant library to use FileSystemObject , to do that:

How do I use FileSystemObject in VBA?

Within Excel you need to set a reference to the VB script run-time library. The relevant file is usually located at \\Windows\\System32\\scrrun.dll

• To reference this file, load the Visual Basic Editor ( ALT + F11 )
• Select Tools > References from the drop-down menu
• A listbox of available references will be displayed
• Tick the check-box next to ' Microsoft Scripting Runtime '
• The full name and path of the scrrun.dll file will be displayed below the listbox
• Click on the OK button.