Cambiar columnas por filas en Excel, manteniendo la primera columna

Te anexo la macro

Sub Cambiar()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")    'hoja con colores
    Set h2 = Sheets("Hoja2")    'hoja resulado
    h2.Cells.ClearContents
    k = 2
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        For j = 2 To h1.Cells(i, Columns.Count).End(xlToLeft).Column
            h2.Cells(k, "A") = h1.Cells(i, "A")
            h2.Cells(k, "B") = h1.Cells(i, j)
            k = k + 1
        Next
    Next
    MsgBox "Fin"
End Sub

Pon tus datos con colores en la "hoja1", empezando en la celda A1 el título y en la A2 los datos.

Crea una hoja llamada "hoja2". Los resultados quedarán en la hoja2

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Buenas tardes,

Imaginé una matriz como la siguiente, pero puede ser cualquiera:

Luego armé una rutina que sólo necesita que le indiques dónde empiezan los datos a trasponer y a partir de qué celda hacerlo.

Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:

Sub Traspon()
'---- Variables modificables ----
'=== AQUI, modifica estos datos de acuerdo a tu proyecto:
    Inicelda = "A3" ' primera celda origen de rango a modificar
    IniDest = "G1" 'Celda destino donde realizar la trasposición
'---- fin Variables
'
'---- inicio de rutina:
'  
FilaDest = 0
UltFila = Range(Left(Inicelda, 1) & Rows.Count).End(xlUp).Row
For Fila = 0 To UltFila
    LaCol = 1
    DatoFijo = Range(Inicelda).Offset(Fila).Value
    Do While Not IsEmpty(Range(Inicelda).Offset(Fila, LaCol))
        Range(IniDest).Offset(FilaDest, 0).Value = DatoFijo
        Range(IniDest).Offset(FilaDest, 1).Value = Range(Inicelda).Offset(Fila, LaCol)
        FilaDest = FilaDest + 1
        LaCol = LaCol + 1
    Loop
Next
End Sub

Nota que, al principio del código, hay unas variables para que lo adaptes a tu archivo. Es decir que tu matriz puede tener la cantidad de columnas y de filas que sean y la rutina seguirá funcionando.

.