Macro transponer varias filas en columnas
Quería ver la posibilidad de a través de una macro poder transponer varias filas en dos columnas.
Las filas se disponen del siguiente modo:
Fecha
Dato
01/01/2016 01/01/2016 01/01/2016 etc etc
1 5 10
02/01/2016 02/01/2016 03/01/2016 etc etc
10 20 50
Mi interés es que la macro vaya recorriendo la fila fecha y la de dato correspondiente y vaya pegando todo a dos columnas, la primera con las fechas, y la segunda con el dato, tal que se quedaría de este modo:
01/01/2016 1
01/01/2016 5
01/01/2016 10
02/01/2016 10
02/01/2016 20
02/01/2016 50
Decir que el rango que tengo actualmente de datos sería B3:IZ734
Podrían ayudarme,. He estado mirando diferentes respuestas pero ninguna encaja con lo que necesito.
1 Respuesta
Prueba lo siguiente:
Sub transponer()
Dim sh1 As Worksheet
Dim i As Long, k As Long, uc As Long
'
Set sh1 = Sheets("Hoja1")
k = 3
uc = sh1.Cells(3, Columns.Count).End(1).Column
For i = 3 To sh1.Range("B" & Rows.Count).End(3).Row Step 2
Sheets("Hoja2").Range("B" & k).Resize(uc, 2).Value = Application.Transpose(sh1.Range("B" & i).Resize(2, uc))
k = k + uc - 1
Next
End Sub
¡Gracias! Amigo, funcionó perfectamente, aunque tengo un rango de datos muy extenso, el rango es b3:iz734, y me tarda mucho en transponer. Hay alguna forma de agilizar? No obstante gracias compañero.
Prueba lo siguiente:
Sub transponer_2()
Dim a As Variant, b As Variant
Dim i As Long, j As Long, k As Long, uf As Long, uc As Long
Dim sh1 As Worksheet
'
Set sh1 = Sheets("Hoja1")
uf = sh1.UsedRange.Rows(sh1.UsedRange.Rows.Count).Row
uc = sh1.UsedRange.Columns(sh1.UsedRange.Columns.Count).Column
'
a = sh1.Range("B3", sh1.Cells(uf, uc))
ReDim b(1 To uf * uc, 1 To 2)
For i = 1 To UBound(a, 1) Step 2
For j = 1 To UBound(a, 2)
k = k + 1
b(k, 1) = a(i, j)
b(k, 2) = a(i + 1, j)
Next
Next
Sheets("Hoja2").Range("B3").Resize(UBound(b), 2).Value = b
End Sub
