Excel VBA使用单元格引用从另一个工作簿复制数据

Question

我在单元格 B1 中指定了文件名，我正在尝试从另一张表中导入数据。目前这是抛出 subscription-out-of-range 错误。有什么简单的方法可以解决这个问题吗？或者另一种首选方法？唯一的要求是单元格包含来自另一个工作簿的数据（文本），而不是引用它的公式。

Sub UpdateFileInfo()
    If (Range("B1") = "") Then
        Range("A2:R200").Value = ""
    Else
        Filename = Range("B1").Value  

        Range("A2:R200") = Workbooks(Filename).GetActiveSheet.Range("A2:R200").Value

    End If
End Sub

Answer 1

如果您已经知道源工作表名称（例如：“Sheet1”），您可以使用它

Option Explicit

Sub UpdateFileInfo2()
    With Range("A2:R200") ' reference target range
        If Range("B1") = "" Then ' if currently active sheet B1 cell is empty
            .ClearContents ' clear referenced range content
        Else
            .FormulaR1C1 = "='C:\Users\...\[" & Range("B1").Value & "]Sheet1'!RC" ' fill referenced range with formulas pointing at the corresponding cell in the wanted sheet of the wanted workbook
            .Value = .Value ' get rid of formulas and leave values only
        End If
    End With
End Sub

否则，您可以使用此模式：

Sub UpdateFileInfo2()
    With Range("A2:R200") ' reference target range
        If Range("B1") = "" Then ' if currently active sheet B1 cell is empty
            .ClearContents ' clear referenced range content
        Else
            .Value = Workbooks.Open(Range("B1").Value).ActiveSheet.Range(.Address).Value ' have refereneced range values as the newly opened workbook activesheet corresponding one
            ActiveWorkbook.Close false ' close newly opened workbook
        End If
    End With
End Sub

如果您的Range("B1").Value 不包含文件的完整路径，请添加它：

Sub UpdateFileInfo2()
    With Range("A2:R200") ' reference target range
        If Range("B1") = "" Then if currently active sheet B1 cell is empty
            .ClearContents ' clear referenced range content
        Else
            .Value = Workbooks.Open("C:\Users\...\" & Range("B1").Value).ActiveSheet.Range(.Address).Value ' have refereneced range values as the newly opened workbook activesheet corresponding one
            ActiveWorkbook.Close false ' close newly opened workbook
        End If
    End With
End Sub

---

Answer 2

您收到此错误是因为工作簿未打开。

为此，您必须在写入打开工作簿的 range("A2:R200") 的命令之前添加一行。但是，您将打开多个工作簿，因此您可能希望使用变量来使这个更清晰：

Sub UpdateFileInfo()

    Dim LocalWorkbook As Workbook
    Dim RemoteWorkbook As Workbook

    Set LocalWorkbook = ActiveWorkbook

    If (Range("B1") = "") Then
        Range("A2:R200").Value = ""
    Else
        FullFilename = Range("B1").Value
        Set RemoteWorkbook = Workbooks.Open(Filename:=FullFilename, ReadOnly:=True)

        LocalWorkbook.ActiveSheet.Range("A2:R200") = RemoteWorkbook.ActiveSheet.Range("A2:R200").Value

        RemoteWorkbook.Close SaveChanges:=False
    End If
End Sub

通常，当您收到订阅超出范围错误时，这是​​因为您使用键或索引引用集合的元素（在本例中为工作簿集合）或数组的元素不存在的。