匹配＆amp;索引从多个工作表中查找数据并在一个工作表上汇总

Question

我每天都有大约两年的库存数据。

股票数据在556个文件中，但以相同的方式排列（注意在此期间已列出约5个额外股票）。我想通过使用匹配和索引以及我的股票代码列表（命名为＆＃34; MatchRange＆＃34;）从556个文件中选择它们来总结一个工作表上股票价格的变动。我已将556文件的文件名放在摘要工作表的第2行。

我已经使用了以下代码但未按预期工作。它只是打开文件并关闭它们。有没有人有关于如何改进代码的任何提示？

Sub NSEMerger()

Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim i As Long
Dim n As Long
Dim c As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim MatchRange As Range
Dim LookupRange As Range
Dim IndexRange As Range

'Define where data is being copied to, source folder and counter
Set SummarySheet = ActiveSheet
FolderPath = "C:\Users\lxxxx\Desktop\NSE Attachments\"
i = 1

'Define the size of the match range
n = Application.WorksheetFunction.Count(Range("MatchRange"))

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")


' Loop for all file names along the top row
Do While FileName = Range("A2").Offset(0, i).Value & ".xls"

    ' Open a workbook in the folder and define lookup range for match function and index range
    Set WorkBk = Workbooks.Open(FolderPath & FileName)
    Set LookupRange = WorkBk.Worksheets(1).Range("H:H")
    Set IndexRange = WorkBk.Worksheets(1).Range("D:D")

    ' Open workbook and do match index
    For c = 1 To n Step 1

    SummarySheet.Range("MatchRange")(c).Offset(0, i).Value = Application.WorksheetFunction.Index(IndexRange, Application.WorksheetFunction.Match(SummarySheet.Range("MatchRange")(c), LookupRange, 0))

    Next

    ' Close the source workbook without saving changes.
    WorkBk.Close savechanges:=False

    ' Increase i to move to next data
    i = i + 1

    ' Use Dir to get the next file name.
    FileName = Dir()
Loop   
End Sub