Transponer datos por orden de color

Esto te puede ayudar en algo

https://www.youtube.com/watch?v=imOOYE9mlKM&list=PLdK9H5dMIfQhn9waYbEdu3DYAuBdSCIBx

Tienes varios problemas en tus datos que deberás corregir, ya que la macro no puede arreglarlos, y siempre tendrás problemas para ordenar, clasificar, buscar, contar, etc, etc.

Por ejemplo:

- Tienes días con guión 21-mar (21 martes), pero eso para excel es una fecha, entonces para excel es 21 de marzo de 2020.
- Cada nombre debería tener grupos de filas en pares, es decir, una fila con días y la fila de abajo con horarios.
- En varios nombres falta la fila de abajo con los horarios.

- Tienes nombres con espacios en blanco a la izquierda y también a la derecha. Mira el siguiente ejemplo:

- Tienes celdas vacías y celdas con "- -" deberías de homologar, elige uno de los 2 utilízalo en todas las celdas.

- Puse varias condiciones en la macro para conseguir los resultados esperados. Pero deberás hacer las correcciones en tu información. Como te comenté, arreglar tu información evitará otros errores en el futuro.

Prueba la siguiente macro en el archivo que compartiste. El resultado estará en la "Hoja2".

Cambié el estilo de la macro, ahora el proceso es inmediato. Solamente tendrás que aplicar el formato que tú desees en la "Hoja2".

Sub Transponer_Datos()
'DECLARACIÓN DE VARIABLES
  Dim h1 As Worksheet, h2 As Worksheet
  Dim i As Long, j As Long, k As Long
  Dim a As Variant, b As Variant, m As Variant
  Dim entra As Boolean
'DATOS INICIALES
  Application.ScreenUpdating = False
  Set h1 = Sheets("Hoja1")
  Set h2 = Sheets("Hoja2")
  a = h1.Range("A1:J" & h1.Range("A" & Rows.Count).End(3).Row + 1).Value
  ReDim b(1 To UBound(a) * 10, 1 To 3)
'PROCESO
  For i = 1 To UBound(a) - 1
    If UCase(Left(Trim(a(i, 1)), 1)) Like "[A-Z]" Then
      'Copia titulos
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 2) = a(i, 5)
      b(k, 3) = a(i, 6)
    Else
      'Copia días y horarios
      entra = True
      If UCase(Left(Trim(a(i + 1, 1)), 1)) Like "[A-Z]" Then entra = False
      If IsDate(a(i + 1, 1)) Then
        m = LCase(Format(a(i + 1, 1), "mmm"))
      Else
        m = LCase(Right(Trim(a(i + 1, 1)), 3))
      End If
      If m <> "" Then
        If "lunmarmiejueviesabdom" Like "*" & m & "*" Then entra = False
      End If
      For j = 1 To 10
        k = k + 1
        b(k, 2) = a(i, j)
        If entra Then b(k, 3) = a(i + 1, j)
      Next
      If entra Then i = i + 1
    End If
  Next
'SALIDA
  h2.Range("A:C").ClearContents
  h2.Range("A1").Resize(k, 3).Value = b
  Application.ScreenUpdating = True
End Sub

¿Antes de hacer una macro para esto me gustaría saber porque te sucede esto? ¿Qué estas haciendo mal para que tengas que hacer esta clase de cosas? Te recomiendo que investigues de forma sencilla como funciona Access, una base de datos super básica para poder gestionar datos como excel no lo hará nunca.

Si me explicas un poco como quieres trasponer esto, quizá veo como se puede hacer. Entiendo que cuando encuentras un titulo verde lo que hay a continuación es la Sección que quieres trasponer, ¿no? Además tendrás que indicarme cual es el color en hexadecimal o rgb que tiene ese texto. Si no es el mismo exactamente no dará resultado. Si le das a las opciones de excel de editar el color debería salirte por ahí el color exacto.

Sin embargo recuerda que sera una solución única para esto en concreto, cualquier cosa ligeramente diferente no servirá. Si estas haciendo algo que te saca este tipo de datos deberías cambiar tu forma de trabajar.