Want to copy data from one sheet to a specific row on another sheet when the adjacent cell

example.jpg

I have a workbook with four sheets showing sales against various departments in a few stores. The first sheet has a list of all departments in all stores in Column A

The 2nd to 4th sheets contain the only the departments that had actual sales in column "A", and the Value of the Sales in Column "B". I am looking to run a macro to achieve the following:

Check text in Column "A" in "Sheet2" and compare with Column "A" in "Sheet1", If a match is found copy the Value in Column "B" of "Sheet2" to the Cell adjacent to the matching Column "A" in Sheet 1

Check text in Column "A" in "Sheet3" and compare with column A in Sheet 1, If a match is found copy the Value in Column "C" of "Sheet3" to the Cell adjacent to the matching Column "A" in "Sheet1"

Check text in Column "A" in "Sheet4" and compare with column A in "Sheet1", If a match is found copy the Value in Column "D" of "Sheet4" to the Cell adjacent to the matching Column "A" in Sheet 1

I have started with the below but seem to be failing badly....

Thanks for any help.

Sub MatchEntries()

Dim WsA As Worksheet 'Sheet1
Dim WsB As Worksheet 'Sheet2
'Dim WsC As Worksheet 'Sheet3
'Dim WSD As Worksheet 'Sheet4
Dim Cell As Range ' Cells in RngA
Dim Fnd As Range ' Find match
Dim R As Long, C As Long ' row and column

With ActiveWorkbook
Set WsA = .Worksheets("Sheet1")
Set WsB = .Worksheets("sheet2")
' Set WsC = .Worksheets("Sheet3")
' Set WSD = .Worksheets("sheet4")
End With

For Each Cell In WsB.Range("A1:A40")
Set Fnd = WsA.Columns(1).Find(What:=Cell.Value, LookIn:=xlFormulas, LookAt:=xlWhole)

If Fnd Is Nothing Then
MsgBox "I couldn't find " & Cell.Value & " in worksheet 'Checklist'"

Else
R = Fnd.Row
For C = 2 to 2

WsA.Cells(R, C).Value = WsB.Cells(R, C).Value


Next C

End If

Next Cell
End Sub

It's difficult to work with pictures. Could you attach a copy of your file?

Try:

Please Login or Register  to view this content.

My pleasure.