Untitled

Sub MatchAndColorNames()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim cell1 As Range
    Dim cell2 As Range
    Dim nameToFind As String
    Dim colorIndex As Long

    ' Set references to your sheets
    Set ws1 = ThisWorkbook.Sheets("Piramidės") ' Change Sheet1 to the name of your first sheet
    Set ws2 = ThisWorkbook.Sheets("2024-11-09") ' Change Sheet2 to the name of your second sheet

    ' Loop through each cell in the first sheet
    For Each cell1 In ws1.UsedRange
        If cell1.Interior.ColorIndex <> -4142 Then ' Check if the cell is colored
            nameToFind = cell1.Value
            colorIndex = cell1.Interior.ColorIndex
            
            ' Search for the matching name in the second sheet
            For Each cell2 In ws2.UsedRange
                If cell2.Value = nameToFind Then
                    cell2.Interior.ColorIndex = colorIndex ' Apply the color to the matching cell
                End If
            Next cell2
        End If
    Next cell1
End Sub