Reference/copy data from another workbook based on another cell's value

[Restricted]

Hi,

I have the following 2 workbooks:
https://imgur.com/a/kwU4bvJ

The aim is to be able to click on the command button, which everytime when clicked (a check is ran that checks whether there is a cell within workbook 'Book1_Adventure' with the value of "Not yet activated", and if so, obtains the values from both 'foo1' and 'foo2' columns of the same row, and dumps these two values into the cells G5 and H5 within workbook 'Book2_Adventure'.

I would presume a mixture of VLOOKUP, offset, and perhaps Range.Copy and PasteSpecial, or is there a more efficient way to do this?


So far, my current solution is to ask the user to select the range which they want copied, but this is very inefficient and I thought a button that automatically searches and dumps the values would be much more efficient:

Sub NextValue()

    Dim rng As Range
    
    Dim wsMain As Worksheet
    Dim wsData As Worksheet
    
    Dim rngToCopy As Range
    
    Application.DisplayAlerts = False
    
    Set wsMain = ThisWorkbook.ActiveSheet
    Set wsData = Workbooks("Book1_Adventure.xlsx").Sheets("SRC")
    
    Set rng = Application.InputBox("Select a range", "Obtain Range", Type:=8) ' ask user to select the range
    
    Set rngToCopy = wsData.Range(rng.Address) ' set the range
    rngToCopy.Copy ' copy the range
    
    wsMain.Range("G4,G5").PasteSpecial xlPasteValues ' paste into the destination workbook's cells G4 and G5, respectively

End Sub

Any suggestions? Thank you for your help

 

[Restricted]

bump

 

[Restricted]

bump - not sure what exactly I'm doing wrong with my post that has discouraged replies? I have put in as much details as I can, as well as provided an attempted solution that I've done myself and have been periodically bumping this thread... can someone let me know?

 

[Restricted]

bump...

 

[Restricted]

bump!

 

[DanteAmor]

Try this

Sub copy_data()
    Dim w1 As Workbook, w2 As Workbook
    Dim sh1 As Worksheet, sh2 As Worksheet
    
    Application.ScreenUpdating = False
    Set w1 = ThisWorkbook
    Set sh1 = w1.ActiveSheet
    Set w2 = Workbooks("Book1_Adventure.xlsx")
    Set sh2 = w2.Sheets("SRC")
    lr = sh2.Range("C" & Rows.Count).End(xlUp).Row
    sh2.Range("C4:G" & lr).AutoFilter 1, "Not yet activated"
    sh2.Range("F5:G" & lr).Copy
    sh1.Range("G4").PasteSpecial xlPasteValues
    sh2.ShowAllData
    MsgBox "Done"
End Sub