Macro de Excel para colocar columnas de datos una debajo de otra, dejando siempre fijas los datos de tres columnas

Queda por aclarar dónde se buscarán esas columnas (nombres de hojas, ¿todas las hojas? ) ¿Y si todo el resumen va en una misma hoja ya creada ... o debe crearse?

* No valores aún, solo envía las aclaraciones.

Puedes poner un par de registros con datos de ejemplo de qué es lo que tienes y qué esperas de resultado.

Si lo puedes poner con imágenes sería mucho mejor, procura que en las imágenes se vean las filas y las columnas de excel para ver exactamente en dónde tienes tus datos.

Hola Dante,

Gracias por el interés mostrado ante esta duda. Diculpadme, por que releyéndome, no me he explicado correctamente. Te envío la información que me solicitas. Envío dos imágenes explicativas.

Informe - Entrada.jpg (En el, se ve como llegaría el informe real con los datos en la hoja1. He añadido una particularidad que se me olvidó en la pregunta y son los datos de la fila superior a partir de la celda D1 que tengo que transponerlos en la columna B. He utilizado colores en los datos para que se aprecie mejor dónde tienen que quedar colocados. Nota: las columnas pueden variar de un informe a otro, puede haber más columnas a partir de la F. Las filas también pueden variar de un informe a otro, puede haber más filas a partir de la 6)

Informe - Salida.jpg (Así es como tendrían que ordenarse los datos en la hoja2 con la macro. Nota: En la columna B se han rellenado los datos de la fila 1)

Espero haberme explicado algo mejor.

Muchas gracias por vuestra ayuda

Te anexo la macro.

Cambia en la macro "Hoja1" y "Hoja2" por los nombres de tus hojas.

Sub Colocar_Columnas()
'Por Dante Amor
    Set h1 = Sheets("Hoja1")    'hoja origen
    Set h2 = Sheets("Hoja2")    'hoja destino
    '
    h2.Rows("2:" & Rows.Count).ClearContents
    k = 2
    For j = Columns("D").Column To h1.Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 3 To h1.Range("A" & Rows.Count).End(xlUp).Row
            h2.Cells(k, "A").Value = h1.Cells(i, "A").Value
            h2.Cells(k, "B").Value = h1.Cells(1, j).Value
            h2.Cells(k, "C").Value = h1.Cells(i, "C").Value
            h2.Cells(k, "D").Value = h1.Cells(i, j).Value
            k = k + 1
        Next
    Next
    MsgBox "Fin"
End Sub

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 
'.[Avísame cualquier duda