Sub mrshkei()
Dim col As New Collection, i As Long, lr As Long, n As Long, j As Long, tt As String, arr, arr2
Dim dd As String
dd = " // "
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
If Cells(i, 1).Interior.ColorIndex = 4 Then
    On Error Resume Next
    For n = 1 To 52
        If tt = Empty Then
            tt = Cells(i, n)
        Else
            tt = tt & dd & Cells(i, n)
        End If
    Next n
    col.Add tt, tt
    tt = ""
End If
Next i
For n = 1 To col.Count
arr = Split(col(n), dd)
    For i = 2 To lr
        arr2 = Split(Cells(i, 1), " ")
        If arr2(0) = Split(arr(0), " ")(0) Then
            For j = 3 To 51
                If Cells(i, j) = Empty And arr(j - 1) <> Empty Then
                    Cells(i, j) = arr(j - 1)
                End If
            Next j
            Cells(i, j).Interior.ColorIndex = 4
        End If
    Next i
Next n
Application.ScreenUpdating = True
End Sub

Sub mrshkei()
Dim i As Long, lr As Long, j As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
If Cells(i, 1).Interior.ColorIndex = 4 Then
    If Split(Cells(i, 1), " ")(0) = Split(Cells(i - 1, 1), " ")(0) Then
        For j = 3 To 51
            If Cells(i - 1, j) = Empty And Cells(i, j) <> Empty Then
                Cells(i - 1, j) = Cells(i, j)
                Cells(i - 1, j).Interior.ColorIndex = 3
            End If
        Next j
    End If
End If
Next i
Application.ScreenUpdating = True
End Sub