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

【问题标题】：VBA code to reference ranges from closed sheets taking path\file\range from a list of cell values从单元格值列表中获取路径\文件\范围的封闭工作表中引用范围的 VBA 代码
【发布时间】：2013-12-22 21:00:33
【问题描述】：

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

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

等等超过一百行。要导入的范围始终命名为“targetrange”。目标文件将始终关闭。我需要在地址旁边的八个单元格中导入目标数据（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 RETRIEVE(PATH, FILENAME, SHEETNAME, CELL)
    RETRIEVE = "='" & PATH & "[" & FILENAME & "]" & SHEETNAME & "'!" & CELL & ""
End Function

【问题讨论】：

请向我们展示您目前拥有的代码。
我已将此代码添加到您的问题中 - RetrievePath 是什么？
嗨，retrievepath 是一种用于将数据引用作为函数执行的方法\ Function RETRIEVE(PATH, FILENAME, SHEETNAME, CELL) RETRIEVE = "='" & PATH & "[" & FILENAME & " ]" & SHEETNAME & "'!" & CELL & "" 结束函数没用

标签： vba excel

【解决方案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

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

【讨论】：