Sub Test()
    Dim r As Long, c As Long
    Application.ScreenUpdating = False
        For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
            For c = 25 To 7 Step -1
                If Cells(r, c).Value <> "" Then
                    Cells(r, 28).Value = Cells(r, c).Value: Exit For
                End If
            Next c
        Next r
    Application.ScreenUpdating = True
End Sub