Ayuda insertra varios registros (macro)
Buenos Días, mi pregunta es la siguiente tengo un archivo con la siguiente estructura:
100 0001 000002 W1192VB
100 0001 000003 W1118AVB
Necesito un procedimiento automático para inserta el archivo 5 valores iguales debajo de la celda quedadndo así:
100 0001 000002 W1192VB
100 0001 000002 W1192VB
100 0001 000002 W1192VB
100 0001 000002 W1192VB
100 0001 000002 W1192VB
100 0001 000003 W1118AVB
100 0001 000003 W1118AVB
100 0001 000003 W1118AVB
100 0001 000003 W1118AVB
Y así sucesivamente, pero debe ser automático porque son 3000 rgistros, agradezco su colaboración de carácter urgente...
100 0001 000002 W1192VB
100 0001 000003 W1118AVB
Necesito un procedimiento automático para inserta el archivo 5 valores iguales debajo de la celda quedadndo así:
100 0001 000002 W1192VB
100 0001 000002 W1192VB
100 0001 000002 W1192VB
100 0001 000002 W1192VB
100 0001 000002 W1192VB
100 0001 000003 W1118AVB
100 0001 000003 W1118AVB
100 0001 000003 W1118AVB
100 0001 000003 W1118AVB
Y así sucesivamente, pero debe ser automático porque son 3000 rgistros, agradezco su colaboración de carácter urgente...
1 Respuesta
Respuesta de Eduard Caballero
1
Prueba esto. Estoy asumiendo que los datos comienzan en la celda A2
Para probralo haz una copia de los datos
Sub inserta()
Application.ScreenUpdating = False
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
i = 1
For i = 1 To 4
Selection.EntireRow.Select
Selection.Copy
Selection.EntireRow.Insert
Next i
ActiveCell.Offset(5, 0).Select
Loop
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Para probralo haz una copia de los datos
Sub inserta()
Application.ScreenUpdating = False
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
i = 1
For i = 1 To 4
Selection.EntireRow.Select
Selection.Copy
Selection.EntireRow.Insert
Next i
ActiveCell.Offset(5, 0).Select
Loop
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Hola, elmatador, a garezco tu colaboración, coori la macro y me bloquea el excel, jejej, dejame aclaro el tema tengo el siguientye esquema:
A B C D
1 100 002 1001 ABCDE
2 100 002 1001 GHGSC
3 100 003 1002 CYUDGD
4 .
5 .
Necesito es que todo lo de la fila 1 (abcd) se inserten 5 veces hacia abajo, y luego el segundo valor a2 (se inserte 5 veces hacia bajo) de latl manera que cada registro se repita 6 veces uno debajo del otro.
Pero la verdad no he podido, agradezco tu colaboraciom, gracias.
A B C D
1 100 002 1001 ABCDE
2 100 002 1001 GHGSC
3 100 003 1002 CYUDGD
4 .
5 .
Necesito es que todo lo de la fila 1 (abcd) se inserten 5 veces hacia abajo, y luego el segundo valor a2 (se inserte 5 veces hacia bajo) de latl manera que cada registro se repita 6 veces uno debajo del otro.
Pero la verdad no he podido, agradezco tu colaboraciom, gracias.
Modificando el código lo hace. Pero si tienes gran cantidad de datos debes esperar a que termine de realizar el procedimiento
Sub inserta()
Application.ScreenUpdating = False
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
i = 1
For i = 1 To 5
Selection.EntireRow.Select
Selection.Copy
Selection.EntireRow.Insert
Next i
ActiveCell.Offset(6, 0).Select
Loop
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Me dices que tienes 3000, eso lo aumentara a 18000 registros
Prueba en una hoja aparte con pocos datos y veras que funciona
Sub inserta()
Application.ScreenUpdating = False
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
i = 1
For i = 1 To 5
Selection.EntireRow.Select
Selection.Copy
Selection.EntireRow.Insert
Next i
ActiveCell.Offset(6, 0).Select
Loop
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Me dices que tienes 3000, eso lo aumentara a 18000 registros
Prueba en una hoja aparte con pocos datos y veras que funciona
