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???
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 respuesta
Respuesta de santiagomf
1
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
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!
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.
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.
