Is it what you need ...?
Sub Treat()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim LR As Long
Dim WkRg As Range
Dim F As Range
Dim ObjDic As Object
Set ObjDic = CreateObject("Scripting.Dictionary")
Const FR As Integer = 2 ' First Row
Const NbC As Integer = 23 ' Number of columns to color
Application.ScreenUpdating = False
Set WS1 = Worksheets("TeamLookupChart")
Set WS2 = Worksheets("ResourceAssignments")
With WS1
LR = .Cells(Rows.Count, "A").End(3).Row
Set WkRg = Range(.Cells(FR, "A"), .Cells(LR, "A"))
End With
For Each F In WkRg
Set ObjDic.Item(F.Value) = F
Next F
With WS2
LR = .Cells(Rows.Count, "A").End(3).Row
Set WkRg = Range(.Cells(FR, "A"), .Cells(LR, "A"))
End With
For Each F In WkRg
If (ObjDic.exists(F.Value)) Then
ObjDic.Item(F.Value).Copy
F.Resize(, 23).PasteSpecial Paste:=xlPasteFormats
End If
Next F
Application.ScreenUpdating = True
End Sub
Bookmarks