Transponer datos de una hoja a otra con otro formato
Me puede ayudar con una macro para transponer datos que se encuentran en la hoja1 a la hoja2 con un nuevo formato como se ve en la hoja2
Respuesta de Dante Amor
1
Te anexo la macro
Sub Transponer_Datos()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
h2.Cells.Clear
j = 1
For i = 3 To h1.Range("A" & Rows.Count).End(xlUp).Row Step 8
h1.Cells(i, "A").Copy h2.Cells(j, "A")
h1.Cells(i, "E").Copy h2.Cells(j, "B")
h1.Cells(i, "F").Copy h2.Cells(j, "C")
j = j + 1
h1.Range(h1.Cells(i + 1, "A"), h1.Cells(i + 1, "J")).Copy
h2.Cells(j, "B").PasteSpecial Paste:=xlAll, Transpose:=True
h1.Range(h1.Cells(i + 2, "A"), h1.Cells(i + 2, "J")).Copy
h2.Cells(j, "C").PasteSpecial Paste:=xlAll, Transpose:=True
j = j + 10
h1.Range(h1.Cells(i + 3, "A"), h1.Cells(i + 3, "J")).Copy
h2.Cells(j, "B").PasteSpecial Paste:=xlAll, Transpose:=True
h1.Range(h1.Cells(i + 4, "A"), h1.Cells(i + 4, "J")).Copy
h2.Cells(j, "C").PasteSpecial Paste:=xlAll, Transpose:=True
j = j + 10
h1.Range(h1.Cells(i + 5, "A"), h1.Cells(i + 5, "J")).Copy
h2.Cells(j, "B").PasteSpecial Paste:=xlAll, Transpose:=True
h1.Range(h1.Cells(i + 6, "A"), h1.Cells(i + 6, "J")).Copy
h2.Cells(j, "C").PasteSpecial Paste:=xlAll, Transpose:=True
j = j + 10
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
