ByVal/ByRef复制数据[VBA]

Question

[答案找到了- -的问题不是和Sourcerange有关的。显然，这是因为我没有在Extractdata1中为每个inputWB指明“Extractdata1”。在某种程度上，这导致代码为每个输出单元产生相同的值。在为每个inputWB添加.xlsx之后，我能够得到不同的值。]

我在这里有一个代码，在这里我试图使用ByVal。为了我的目的，我找不到很多资源来学习ByVal写作(复制粘贴数据)，所以我在努力学习它。

目的:从3种不同输入WB的细胞H17中提取数据，分别粘贴到输出WB的A1、A2、A3中。

问题:下面的代码在A1、A2和A3中给出了相同的值.该值等于上次打开的输入WB (而不是来自3个不同输入WB的3个值)。

我也尝试过ByRef，但它没有解决问题。

提前谢谢你。

Sub Extractdata()
    Dim FromPath As String
    Dim FromSheetName As String
    Dim TargetRange As Range

    With Workbooks.Open("C:\Users\[OutputWB].xlsm").Worksheets("Sheet1")
        Extractdata1 "C:\Users\[InputWB1]", "[InputSheet]", .Range("A1")
        Extractdata1 "C:\Users\[InputWB2]", "[InputSheet]", .Range("A2")
        Extractdata1 "C:\Users\[InputWB3]", "[InputSheet]", .Range("A3")
    End With
End Sub


Sub Extractdata1(ByVal FromPath As String, ByVal FromSheetName As String, ByVal TargetRange As Range)
    With Workbooks.Open(FromPath)
        With .Worksheets(FromSheetName)
            Set SourceRange = .Range("H17")
            TargetRange.Value = SourceRange.Value    
        End With    
    End With
End Sub

Answer 1

从不同文件复制同一单元格

，

• ，这是我的作品。也许您可以发现相关的difference.
• ScreenUpdating与其无关，而且在源文件未关闭时也能正常工作。

Option Explicit

Sub Extractdata()

    Const FolderPath As String = "C:\Test\"
    
    Application.ScreenUpdating = False
    
    With Workbooks.Open(FolderPath & "Output.xlsm").Worksheets("Sheet1")
        Extractdata1 FolderPath & "Test1.xlsx", "Sheet1", .Range("A1")
        Extractdata1 FolderPath & "Test2.xlsx", "Sheet1", .Range("A2")
        Extractdata1 FolderPath & "Test3.xlsx", "Sheet1", .Range("A3")
        '.Close SaveChanges:=True
    End With
    
    Application.ScreenUpdating = True

End Sub

Sub Extractdata1( _
        ByVal FromPath As String, _
        ByVal FromSheetName As String, _
        ByVal TargetRange As Range)
    
    With Workbooks.Open(FromPath)
        With .Worksheets(FromSheetName)
            TargetRange.Value = .Range("H17").Value
        End With
        .Close SaveChanges:=False
    End With

End Sub

Answer 2

如果要做的是将单元格的值链接到另一个工作簿中的值，则有一种更简单的方法:将以下公式粘贴到单元格A1、A2 & A3 of OutputWB.xlsm中，则无需编写代码即可完成工作。

='C:\Users\[InputWB1.xlsx]Sheet1'!$H$17
='C:\Users\[InputWB2.xlsx]Sheet1'!$H$17
='C:\Users\[InputWB3.xlsx]Sheet1'!$H$17

如果这不能满足您的需要，请参阅下面的修改代码。我删除了导致文件找不到错误的方括号。我还将文件路径放入变量中，以便于在不同的环境中进行测试。我强烈建议在末尾添加一个关闭文件指令，除非您希望在末尾打开所有工作簿。

Sub Extractdata()

Dim FromPath As String
Dim FromSheetName As String
Dim TargetRange As Range
Dim FilePath As String
FilePath = "C:\Users\"

With Workbooks.Open(FilePath & "OutputWB.xlsm").Worksheets("Sheet1")

Extractdata1 FilePath & "InputWB1", "InputSheet", .Range("A1")
Extractdata1 FilePath & "InputWB2", "InputSheet", .Range("A2")
Extractdata1 FilePath & "InputWB3", "InputSheet", .Range("A3")

End With

End Sub


Sub Extractdata1(ByVal FromPath As String, ByVal FromSheetName As String, ByVal TargetRange As Range)
    With Workbooks.Open(FromPath)
        With .Worksheets(FromSheetName)
Debug.Print (FromPath)
Set SourceRange = .Range("H17")
TargetRange.Value = SourceRange.Value
    
        End With
    
    End With
End Sub