copy certain data from one workbook to another workbook in excel

[christinewhittle]

i have two different workbooks and would like to copy & past from one to the other if certain data in one worksheet matches the other. If data in column A wb1 matches data in column A wb2 on wb1 column D will return the value of wb2 column D

workbook 1
A B C
[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD]12
[/TD]
[TD]misc[/TD]
[TD]80[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]misc[/TD]
[TD]90[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]misc[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD]misc[/TD]
[TD]55[/TD]
[/TR]
[TR]
[TD]19[/TD]
[TD]misc[/TD]
[TD]70[/TD]
[/TR]
</tbody>[/TABLE]

work book 2
A D
[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD]17[/TD]
[TD]25[/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]19[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

i haven't used excel in a while and will appreciate some guidance please... TU

 

[mumps]

Open both workbooks. Place this macro in a regular module in wb1 and run it from there. Change the workbook name and sheet names to suit your needs.

Sub CompareLists()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each Rng In Workbooks("wb2.xlsx").Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
      If Not RngList.Exists(Rng.Value) Then
        RngList.Add Rng.Value, Nothing
      End If
    Next
    For Each Rng In Sheets("Sheet1").Range("A2", Range("A" & Rows.Count).End(xlUp))
      If RngList.Exists(Rng.Value) Then
        Range("D" & Rng.Row) = Workbooks("wb2.xlsx").Sheets("Sheet1").Range("D" & Sheets("Sheet1").Range("A:A").Find(Rng).Row)
      End If
    Next
    RngList.RemoveAll
    Application.ScreenUpdating = True
End Sub

 

[christinewhittle]

Thank you!

 

[mumps]

You are very welcome.