Copiar filas en excel tantas veces como indique un campo
Tengo una serie de datos de productos ordenados por filas (Código, descripción, pvp,...)
En una de las columnas indico la cantidad, y necesito copiar cada fila tantas veces como indique ese campo.
La razón es que uso esta lista para crear etiquetas con word mediante la combinación de correspondencia, de esta manera puedo hacer tantas etiquetas de cada producto como necesite. Si hay otra forma de hacerlo genial. Hasta ahora lo que hago es ir copiando e insertando manualmente, pero cada vez tenemos mas productos y este sistema es tedioso.
1 respuesta
En mi experiencia, he sustituido procesos de combinar correspondencia reproduciendo la página word en una hoja de excel donde puedes actualizar los datos.
Respecto a tu pregunta, tienes que concretar más. En que columna está la cantidad, donde copiar las XX filas
Pensé que sería irrelevante, pero si quieres saber exacto lo que tengo, es esto:
A: Código, B: Descripción, C: Precio, D: Marca, E: Modelo, F: Subfamilia, G: Cantidad
El resultado que quiero, es insertar las filas copiadas, es decir, pasar de esto:
1105510300 / F. Huawei P9Lite gel dibujos B. / 8,182 / Huawei / P9Lite / 1 / 3
1105330300 / F. Huawei P8 Lite gel dibujos B. / 8,182 / Huawei / P8 Lite / 1/ 2
a esto:
1105510300 / F. Huawei P9Lite gel dibujos B. / 8,182 / Huawei / P9Lite / 1
1105510300 / F. Huawei P9Lite gel dibujos B. / 8,182 / Huawei / P9Lite / 1
1105510300 / F. Huawei P9Lite gel dibujos B. / 8,182 / Huawei / P9Lite / 1
1105330300 / F. Huawei P8 Lite gel dibujos B. / 8,182 / Huawei / P8 Lite / 1
1105330300 / F. Huawei P8 Lite gel dibujos B. / 8,182 / Huawei / P8 Lite / 1
Me sirve que se genere en un documento nuevo, y que el numero de copias se mantenga o desaparezca me es indiferente.
Gracias
Esto te servirá:
Sub copiar()
hoja = ActiveSheet.Name
Range("G2").Select
Columna = Range("G2").End(xlDown).Row - 1
For i = 1 To Columna
Application.CutCopyMode = True
copias = ActiveCell.Value
ActiveSheet.Range(ActiveCell, ActiveCell.End(xlToLeft)).Copy
Sheets("Copia").Select
Range("A1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row + copias - 1, 1)).Select
Selection.PasteSpecial xlValues
Sheets("Copiar X veces").Select
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
Next
End Sub
Debes poner un botón de formulario para ejecutar la macro en la hoja donde tengas los datos:
El resultado lo pone en otra hoja:
Esto te debería servir. Tal vez debas adaptarlo un poco a tu hoja en concreto:
Sub copiar()
hoja = ActiveSheet.Name
Range("G2").Select
Columna = Range("G2").End(xlDown).Row - 1
For i = 1 To Columna
Application.CutCopyMode = True
copias = ActiveCell.Value
ActiveSheet.Range(ActiveCell, ActiveCell.End(xlToLeft)).Copy
Sheets("Copia").Select
Range("A1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row + copias - 1, 1)).Select
Selection.PasteSpecial xlValues
Sheets("Copiar X veces").Select
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
Next
End Sub
Debes poner un boton de formulario en la base de datos:
Resultado:
Hola, disculpa que haya tardado tanto en responder, es por los turnos de vacaciones.
Me da un mensaje de error, "Subíndice fuera del intervalo". No lo se solucionar porque la verdad no tengo aún mucha idea de vb.
Gracias
Se me había quedado esto en el tintero. Te subo mi archivo para que puedas comparar y ver que tienes diferente
