ByVal/ByRef to copy data [VBA]-CodePudding

[Answer found - Problem wasn't with the Sourcerange. Apparently it's because I didn't indicate ".xlsx" within Extractdata1 for each of the inputWBs. Somehow, that led to the code churning out the same value for each output cell. After adding .xlsx for each inputWBs, i was able to get the different values.]

I have a code here where i'm trying to use ByVal. I can't find a lot of resources to learn ByVal writing for my purpose (copy paste data), so am struggling with it.

Purpose: Extract data from cell H17 of 3 different input WB, and paste into A1, A2, A3 of output WB respectively.

Problem: The following code currently gives me the same value in A1, A2 and A3... and this value is equal to the last-opened input WB (instead of 3 values from the 3 different input WB).

I have also tried ByRef but it did not fix the problem.

Thank you in advance.

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

CodePudding user response：

Copy Same Cell From Different Files

This is works on my end. Maybe you can spot a relevant difference.
ScreenUpdating has nothing to do with it, and it also worked when the source files were not being closed.

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

CodePudding user response：

If what you want to do is the link the value of a cell to the value in another workbook there is a simpler way to do it: paste the following formulas into Cells A1, A2 & A3 of OutputWB.xlsm and the job will be done without code.

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

If that doesn't meet your need please see the following revised code. I've removed the square brackets which were causing file not found errors. I've also put the file path into a variable to make it easier to test in a different environment. I would strongly advise adding a close file instruction at the end unless you want to keep all the workbooks open at the end.

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