Macro para pasar de renglón

Tengo un archivo de excel con más de 200 registros en la primer hoja, sin embargo, de cada registro, tengo que sacar en una hoja nueva 265 subregistros de un solo registro. Dicha macro ya la realice, el caso que lo que quiero es de que al apretarle al botón, me genere absolutamente todos los registros en una hoja a parte cada uno, no de uno por uno. Aquí envío la macro...
    Sheets("Hoja1").Select
    Range("a2:a2").Copy
    Sheets(nbreHoja).Select
    Range("B2").Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Hoja1").Select
    Range("e2:e2").Copy
    Sheets(nbreHoja).Select
    Range("B3").Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Hoja1").Select
    Range("g2:g2").Copy
    Sheets(nbreHoja).Select
    Range("B4").Select
    Selection.Insert Shift:=xlDown
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
En las partes donde subraye
*Range("a2:a2").Copy
*Range("e2:e2").Copy
*Range("g2:g2").Copy
es ahi donde tengo el error, pq cuando termina de hacerme el primer registro, cuando paso al segundo, me vuelve a tomar los mismos datos de A2,E2,G2, por lo q lo q necesito es aumentar a uno el valor de dichas celdas, como le puedo hacer???
1

1 Respuesta

165.875 pts. Más de 35 años en la informática y más de 20 trabajando...
No sé si es esto exactamente lo que buscas pero creo que se parecerá:
Sub prueba()
    Dim nLin As Integer
    Dim nbreHoja
    nbreHoja = "hoja2"
    For nLin = 2 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
        ' La hoja de destino será "Hoja2" para la línea 2, "Hoja3" para la línea 3... "HojaN" para la línea n
        nbreHoja = "hoja" & Format$(nLin)
        preparaPagina nbreHoja
        Sheets("hoja1").Select
        Sheets("Hoja1").Cells(nLin, 1).Copy
        Sheets(nbreHoja).Range("B2").PasteSpecial Paste:=xlPasteValues
        Sheets("Hoja1").Cells(nLin, 5).Copy
        Sheets(nbreHoja).Range("B3").PasteSpecial Paste:=xlPasteValues
        Sheets("Hoja1").Cells(nLin, 7).Copy
        Sheets(nbreHoja).Range("B4").PasteSpecial Paste:=xlPasteValues
    Next nLin
    Application.CutCopyMode = False
End Sub
Sub preparaPagina(ByVal nomPag As String)
    Dim i As Integer
    For i = 1 To ThisWorkbook.Sheets.Count
        If UCase$(ThisWorkbook.Sheets(i).Name) = UCase$(nomPag) Then Exit For
    Next i
    If i > ThisWorkbook.Sheets.Count Then ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(i).Name = nomPag
End Sub
QUE tal... oye muchas gracias por tu contestación... mira, estuve shecando... y como que esta algo confuso jejejeje, mmmm nada más que quiero pasarte la macro por aquí pero esta algo grande y no me lo permite por el espacio de caracteres que ofrecen aquí, no se si exista la posibilidad en que me pudieras pasar tu correo para pasarte la macro completa y ya te califico por aquí. De todos modos te dejo mi correo por si me puedes hacer el favor, [email protected]
Muchas gracias en vdd!
A ver, cuéntame un poco más en detalle.
Lo que quieres es copiar los datos que aparecen en la hoja1: de las celdas A2, E2 y G2 a las celdas B2, B3 y B4 de la hoja2.
Las celdas A3, E3 y G3 de la hoja1... ¿a dónde se copiarían? ¿Y las celdas A4, E4 y G4?
La macro que te puse las copiará a las celdas B2, B3 y B4 de la Hoja3 y Hoja4 respectivamente (a la hoja 3 las que están en la fila3 de la Hoja1 y a la Hoja4 las que están en la fila 4 de dicha hoja).
Cuéntame y ajutamos la macro.
Si más adelante considero que hace falta mandarnos cosas por correo ya te lo diré. Prefiero no recibir correos (y menos con código) por simple prudencia.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas