How to look up Background Color and format new cell

[Pestomania]

Good day,

Is there a way to have a macro complete the following task:

On sheet1, column A there is a number.
On sheet2, column A are numbers that some will duplicate sheet1.
On sheet2, Column B the cells have been formatted with a background color.
On sheet1, column B the cells need the matching formatting from sheet2 column B.

On sheet1, the macro would look at the value in column A, locate that value on sheet2 column A and copy the background from sheet2 column B to sheet1 column B.

 

[Fluff]

How about

Sub GetColour()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("Pcode")
   Set Ws2 = Sheets("sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.count).End(xlUp))
         If Cl.Offset(, 1).Interior.ColorIndex = -4142 Then
            .Item(Cl.Value) = -4142
         Else
            .Item(Cl.Value) = Cl.Offset(, 1).Interior.Color
         End If
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.count).End(xlUp))
         If .exists(Cl.Value) Then Cl.Offset(, 1).Interior.Color = .Item(Cl.Value)
      Next Cl
   End With
End Sub

 

[jim may]

A bit Crude... but it seems to work...

Sub Foo()
Dim sLoc As String
Dim LR As Long
Dim Rng As Range, C As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("A2:A" & LR)  'Change CellReference of A3 to FIRST NUMERIC Cell Reference
Rng.Offset(, 1).Interior.Color = xlNone
For Each C In Rng
    With Worksheets("Sheet2").Columns("A")
        On Error Resume Next
        sLoc = .Find(What:=C).Address
        If Err = 0 Then
            If sLoc <> "" Then
            C.Offset(, 1).Interior.Color = .Range(sLoc).Offset(, 1).Interior.Color
            End If
        End If
        sLoc = ""
        On Error GoTo 0
    End With
Next C
End Sub