Esta es la primer macro solicitada:
Sub armarHoja()
'x Elsamatilde
Application.ScreenUpdating = False
'hojas involucradas
Set ho1 = Sheets("EJEMPLO SERIES")
'Set ho2 = Sheets("Sheet1") 'como se ejecuta desde esta hoja no hace falta declararla
'ult col en ho1 y 1er fila en ho2
finC = ho1.Range("AA1").End(xlToLeft).Column 'ver Nota2
ini = 24
'limpiar la hoja para un nuevo pase 'ver Nota3
Range("A24:D" & Range("B" & Rows.Count).End(xlUp).Row).Clear
'pasar títulos a hoja2
For x = 3 To finC Step 2
ho1.Cells(3, x).Copy Destination:=Range("A" & ini) 'cod
ho1.Cells(1, x).Copy Destination:=Range("B" & ini) 'descr 1
Range("D" & ini) = Application.WorksheetFunction.Max(ho1.Columns(x - 1)) 'items
If ho1.Cells(2, x) <> "" Then
ho1.Cells(2, x).Copy Destination:=Range("B" & ini + 1) 'descr 2
ini = ini + 1
End If
'dejo una libre para insertar series
ini = ini + 2
Next x
'alineación a izquierda en B y ajuste ancho col A
Range("B24:B" & ini).HorizontalAlignment = xlGeneral
Columns(1).ColumnWidth = 10
'a continuación se pasan las series a col N de hoja activa
For x = 3 To finC Step 2
'limpiar rgo auxiliar en hoja activa
[N:O].ClearContents
Range(ho1.Cells(4, x), ho1.Cells(4, x).End(xlDown)).Copy Destination:=[N1]
'se ejecuta tu macro para transponer las series a col O
Call transponer
'pasar el rango transpuesto insertando tantas filas como sean necesarias a partir de 24
'Call pasarSeries
Next x
MsgBox "Fin del proceso"
End Sub
'*Nota1: si el botón estará en hoja destino no hace falta utilizar la variable ho2
'directamente se menciona el rango sin anteponer ho2.
'*Nota2: no debieras colocar textos que aún no están en uso, como 'descrip'
'cuando necesites agregar nuevos productos irás rellenando dejando siempre 1 col libre
'*Nota3: evaluá si es conveniente borrar el rango antes de un nuevo pase...
Fijate que por cada tabla se pasa la lista de series a col N... y a partir de allí debiera ejecutar la macro que transpone a col O las series y luego el pase a hoja Sheet1.
Solo habilité la de Transponer (en tu libro era Sub CopiarSeries) pero está incompleta... falta la parte que te pasa el contenido de las col D... (ocultas) a col O... no encontré este código pero seguramente lo podrás agregar.
Sub transponer()
'CopiarSeries()
'Buccle series - x Juan Arenas
'ajustada x Elsamatilde
'transpone de col activa a col O
Application.ScreenUpdating = False
' ActiveSheet.UsedRange.Offset(0, 7).ClearContents
Serie = 10
j = 1
'el rango va de N1 hasta el final copiando en O
For i = 1 To Range("N" & Rows.Count).End(xlUp).Row Step Serie
Range(Cells(i, "N"), Cells(i + Serie - 1, "N")).Copy
Cells(j, "O").PasteSpecial Transpose:=True
For k = Columns("O").Column To Columns("O").Column + Serie
c = Columns("O").Column + Serie + 1
Cells(j, c) = Format(Cells(j, c), "0000000") & " " & Format(Cells(j, k), "0000000")
Next
j = j + 1
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
'MsgBox "Fin"
'falta el código que pasa de las col O (antes D) a la col ?
'desde donde se tomará la información para alimentar la col B
End Sub
Sdos!