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

1 respuesta

Respuesta
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

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas