Help With Current Macro Adding Copy Over

Hello,

Below is my Macro which currently takes two sheets and compares column "A in both, and if equal data is in both sheets column "A" it highlights in green. I need to take it one step further. Sheet1 being the master, and each sheet having three columns (A,B,C). I need to take data in Sheet1, column "C" to be copied to Sheet2, column "C" for only those cells that are highlighted in green (have same data in column "A" cells).

Current Highlight Macro

Sub greendifference()
Dim LR As Long, i As Long, x As Variant
LR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    x = Application.Match(Sheets("Sheet1").Range("A" & i).Value, Sheets("Sheet2").Columns("A"), 0)
    If IsNumeric(x) Then
        Sheets("Sheet1").Range("A" & i).Interior.Color = vbGreen
        Sheets("Sheet2").Range("A" & x).Interior.Color = vbGreen
    End If
Next i
End Sub

Thanks JR

Sub greendifference()
Dim LR As Long, i As Long, x As Variant
LR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    x = Application.Match(Sheets("Sheet1").Range("A" & i).Value, Sheets("Sheet2").Columns("A"), 0)
    If IsNumeric(x) Then
        Sheets("Sheet1").Range("A" & i).Interior.Color = vbGreen
        Sheets("Sheet2").Range("A" & x).Interior.Color = vbGreen
 'add this line =>
       Sheets("Sheet2").range("C" & x).value=Sheets("Sheet1").Range("A" & i).value
    End If
Next i
End Sub

the on error ... line was added to prevent the macro crashing if there is no match! NO MATCH => x will remain 0

Sub greendifference()
Dim LR As Long, i As Long, x As Variant

On error resume next

LR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    x=0
    x = Application.Match(Sheets("Sheet1").Range("A" & i).Value, Sheets("Sheet2").Columns("A"), 0)
    If IsNumeric(x) and x>0 Then
        Sheets("Sheet1").Range("A" & i).Interior.Color = vbGreen
        Sheets("Sheet2").Range("A" & x).Interior.Color = vbGreen
 'add this line =>
       Sheets("Sheet2").range("C" & x).value=Sheets("Sheet1").Range("C" & i).value
    End If
Next i
End Sub

Hello,

That seems to work perfect,

Thank you JR

you're are welcome just mark as SOLVED please.