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

我有大约两年的每日股票数据。

股票数据在556个文件中，但以相同的方式排列（注意在此期间已经列出大约5个额外的股票）。 我想通过使用匹配和索引以及我的股票代码清单（名为“匹配范围”）从556个文件中select股票价格，来总结一个工作表中的股价变动。 我已将556个文件的文件名放在摘要工作表的第2行上。

我已经使用了下面的代码，但不能正常工作。 它只是打开文件并closures它们。 有没有人有关于如何改善代码的任何提示？

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