VBA Find text and copy value to the right of the cell

[gubertu]

Hi all,

I would like to know if there is a code to do the following:

I have one tab called "Data" with some financial information and then, I have another sheets where I place this information, for example sheet "A1" and "A2".

Could it be possible to have code, that look if the words of column A of tab "Data" are repeated in the rest of the WB, and then place the amount of column B of tab Data to the right where the word is?
For example, in tab A1, cell B2 and tab A2, cell B2.

Hope I explaned well myself.

Thanks in advance!!


1) Tab "Data"

	A	B
1	Text	Data
2	Buildings	1.000
3	Machinery	2.000

2) Tab "A1"

	A	B
1	Text	Data
2	Buildings	Place value 1.000
	Etc...

2) Tab "A2"

	A	B
1	Text	Data
2	Machinery	Place value 2.000
	Etc...

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, rng As Range, srcWS As Worksheet, ws As Worksheet, fnd As Range
    Set srcWS = Sheets("Data")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In srcWS.Range("A2:A" & LastRow)
        For Each ws In Sheets
            If ws.Name <> "Data" Then
                Set fnd = ws.Range("A:A").Find(rng.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    fnd.Offset(, 1) = rng.Offset(, 1)
                End If
            End If
        Next ws
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Another option

Sub gubertu()
   Dim Cl As Range
   Dim Ws As Worksheet
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   With Sheets("Data")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Cl.Offset(, 1).Value
      Next Cl
   End With
   For Each Ws In Worksheets
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Cl.Offset(, 1).Value = Dic(Cl.Value)
      Next Cl
   Next Ws
End Sub

 

[gubertu]

Thank you all!

I will try these two codes.

Thanks