Macro to open existing WB, copy/paste into another WB

[jaclynresendez]

Ok, I have 2 pre-existing workbooks. I need a macro to open WorkbookA, find "James" in Column B, copy value in Column J of that row, go to Workbook B, find "James" in Column B and paste value in next empty cell in that row. Then close WorkbookA

Not sure if that makes sense.

 

[VoG]

What are the sheet names to search in both workbooks?

 

[jaclynresendez]

WorkbookA - Sheet Name "FST"
WorkbookB - Sheet Name "Tracker"

Thanks!

 

[JSA715]

Try this...

Sub test()
Dim wbA As Workbook
Dim wbB As Workbook
Dim iRow As Integer
Dim iValue As String
Dim iCol As Integer
Set wbA = Workbooks("WorkbookA")
Set wbB = Workbooks("WorkbookB")
iRow = wbA.Sheets("FST").Range("B:B").Find(what:="James").Row
iValue = wbA.Sheets("FST").Range("J" & iRow).Value
iRow = wbB.Sheets("Tracker").Range("B:B").Find(what:="James").Row
wbB.Activate
wbB.Sheets("Tracker").Range("B" & iRow).End(xlToRight).Select
iCol = Selection.Column
Cells(iRow, iCol + 1).Value = iValue
wbA.Close
 
End Sub

 

[VoG]

Or perhaps

Sub try()
Dim Found1  As Range, Found2 As Range, x As Variant, LC As Integer
Workbooks.Open Filename:=ThisWorkbook.path & Application.PathSeparator & "WorkbookA"
Set Found1 = ActiveWorkbook.Sheets("FST").Columns("B").Find(what:="James")
If Found1 Is Nothing Then Exit Sub
x = Found1.Offset(, 8).Value
ActiveWorkbook.Close savechanges:=False
With Sheets("Tracker")
    Set Found2 = .Columns("B").Find(what:="James")
    If Found2 Is Nothing Then Exit Sub
    LC = .Cells(Found2.Row, Columns.Count).End(xlToLeft).Column
    .Cells(Found2.Row, LC + 1).Value = x
End With
End Sub

 

[JSA715]

I like his better...

Alas...MVP vs Newbie

 

[jaclynresendez]

The 2nd worked. You are amazing! Thank you both!

 

[jaclynresendez]

Don't hate me...

Ok, so it works and all, but what would be the easiest way to include multiple "finds"? Below is my ACTUAL working code. How would I continue with the exact same action except instead of finding "MarinMich_NA_C236971", it'll go on to find other unique names like "WilliamsS_NA_C416186" and "WaddellJ_NA_C536507"? I tried on my own but kept getting a subscript out of range error.

Thanks!

Private Sub CommandButton_Retrieve_Click()
Dim Found1 As Range, Found2 As Range, NCH As Variant, AHT As Variant, ACW As Variant, HOLD As Variant, LC As Integer
Workbooks.Open Filename:="\\Snnp-oa-001\snnopsmgmt\Export\FST.xls"
Set Found1 = ActiveWorkbook.Sheets("FST").Columns("A").Find(what:="MarinMich_NA_C236971")
If Found1 Is Nothing Then Exit Sub
NCH = Found1.Offset(, 2).Value
AHT = Found1.Offset(, 3).Value
ACW = Found1.Offset(, 5).Value
HOLD = Found1.Offset(, 8).Value
ActiveWorkbook.Close savechanges:=False
With Sheets("Tracker")
Set Found2 = .Columns("A").Find(what:="MarinMich_NA_C236971")
If Found2 Is Nothing Then Exit Sub
LC = .Cells(Found2.Row, Columns.Count).End(xlToLeft).Column
.Cells(Found2.Row, LC + 1).Value = NCH
.Cells(Found2.Row, LC + 2).Value = AHT
.Cells(Found2.Row, LC + 3).Value = ACW
.Cells(Found2.Row, LC + 4).Value = HOLD
End With
End Sub

 

[jaclynresendez]

Can anyone help?