VBA代码引用从单元格值列表中取path\文件\范围的封闭工作表范围

我需要从100多个excel 2007工作簿中导入保存在不同文件夹中的范围，以检查更改。 我有一个path和文件名称的列表（每个从2到120单独的行）： –

c:\folderA\folderb\file001.xls f:\foldera\folder3\fileaaa.xls d:\folderexample\foldereg\folder12\filea01.xls 

等一百多行。 要导入的范围始终名为“targetrange”。 目标文件将始终closures。 我需要在地址旁边的八个单元格中导入目标数据（1行x 8列）。

我一直无法得到这个成功的工作。

子程序：

  Dim PATH, FILENAME, SHEETNAME, CELL, i PATH = "C:\folderA\folderb\file001.xls" FILENAME = "Book001.xlsm" SHEETNAME = "Sheet1" Range = "targetrange" For i = 1 To 10 Range("B" & i) = RETRIEVE(PATH, FILENAME, SHEETNAME, "A" & i) Next i End Sub 

取回function：

 Function RETRIEVE(PATH, FILENAME, SHEETNAME, CELL) RETRIEVE = "='" & PATH & "[" & FILENAME & "]" & SHEETNAME & "'!" & CELL & "" End Function 

Answer 1

除非你真的想要每个工作表的硬公式参考，下面的代码工作得很好。 但是，YMMV会打开每个工作簿，并将每个工作簿中的targetrange复制到源工作簿。

 Private Sub RetrieveData() Dim SourceSht As Worksheet, TargetWbk As Workbook Dim TargetSht As Worksheet Dim TargetPath As String, TargetRange As Range Set SourceSht = ThisWorkbook.Sheets("ModifyMe") '--Modify as necessary. For i = 1 To 10 '--Modify as necessary. '--Set the path. TargetPath = SourceSht.Range("B" & i).Value '--Turn off everything that can slow/hinder the transfer. With Application .ScreenUpdating = False .DisplayAlerts = False .EnableEvents = False .Calculation = xlCalculationManual End With '--Open the target workbook and qualify all variables. Set TargetWbk = Workbooks.Open(TargetPath) Set TargetSht = TargetWbk.Sheets("Sheet1") Set TargetRange = TargetSht.Range("targetrange") '--Simple copy and paste. TargetRange.Copy SourceSht.Range("C" & i) '--Close the target workbook. TargetWbk.Close '--Turn off everything that can slow/hinder the transfer. With Application .CutCopyMode = False .ScreenUpdating = True .DisplayAlerts = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With Next i End Sub 

让我们知道这是否有效。 请尝试重复您的工作簿。