Sub Transfer()
    
    Dim i, MyRow, LastCol, FirstValue As Long
    Dim sSh, tSh As Object
    Dim RNG As Range
    
    Set RNG = Application.InputBox("Выделите первую ячейку со значением", Type:=8)
    Set sSh = RNG.Parent
    ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Set tSh = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    FirstValue = RNG.Value
    MyRow = RNG.Row
    
    For i = RNG.Column To sSh.Cells(MyRow, Columns.Count).End(xlToLeft).Column Step 2
        If i = RNG.Column Then
            LastCol = tSh.Cells(1, Columns.Count).End(xlToLeft).Column
            tSh.Cells(1, LastCol).Value = FirstValue
        Else
            LastCol = tSh.Cells(1, Columns.Count).End(xlToLeft).Column + 1
            tSh.Cells(1, LastCol).Value = FirstValue + sSh.Cells(MyRow, i).Value
        End If
    Next
    
End Sub

Sub закрашивание()
If Selection.Rows.Count < 2 Then MsgBox ("Выделенный диапазон содержит менее 2-х строк."): Exit Sub
Dim q, r As Range
Dim MyColor As Double
Dim s As Long

On Error Resume Next
Set q = Application.InputBox("Укажите столбец.", Type:=8)
If q Is Nothing Then MsgBox ("Вы не указали столбец."): Exit Sub
Set r = Intersect(Selection, q.EntireColumn)
If r Is Nothing Then MsgBox ("Указанный вами столбец находится вне выделенного диапазона."): Exit Sub
On Error GoTo 0

MyColor = 13434879
Selection.Rows(1).Interior.Color = MyColor

For s = 2 To Selection.Rows.Count
    With r.Cells(s)
        If .Value <> .Offset(-1).Value Then
            If .Offset(-1).Interior.Color = 13434879 Then
                MyColor = 14546642
            Else
                MyColor = 13434879
            End If
        End If
   Selection.Rows(s).Interior.Color = MyColor
    End With
Next

End Sub