Copiar filas con datos varias veces segun valor y numerar copias

jcc-tec · el 27 de febrero

Hola, estoy intentando crear una macro que busque las filas con contenido en una hoja y que haga varias copias de este contenido en otra hoja, numerando el numero de copia. Hasta ahora he conseguido que me encuentre los valores y que copie y pegue pero no que me haga la cantidad de copias y las numere, adjunto codigo por si alguien me puede ayudar y también imagen de datos y resultado final que me gustaría obtener.

Sub Copiar_Filas()

'inicializo la variable j
j = 2
UltimaFila = Cells(Rows.Count, 2).End(xlUp).Row
Dim xCount As Integer
LableNumber:
xCount = Application.InputBox("Copias de Kits", "Total de copias", , , , , , 1)
If xCount < 1 Then
MsgBox "Cantidad de copias insuficiente ,intentar de nuevo", vbInformation, "Zfoam"
GoTo LableNumber
End If
'comienzo el bucle
For I = 2 To UltimaFila

'activo la hoja donde están mis datos
Sheets("Datos").Activate

'compruebo que el valor de la fecha es mayor que 30
If Cells(I, "B").Value <> 0 Then
'copio la fila entera
Range(Cells(I, "A"), Cells(I, "E")).Copy
'selecciono la hoja donde quiero pegar y después la celda
Sheets("Filtro").Activate
Cells(j, "A").Select
'pego la fila que hemos copiado
Rows(I).Resize(xCount).Insert
'aumento la variable j para que vaya a la siguiente fila de la hoja filtros
'cuando encuentre una nueva fila que cumple con la condición de edad
j = j + 1
End If
Next

End Sub

DiegoLG · el 27 de febrero

Sube tu archivo, con ejemplos,

y vemos que se puede hacer

Saludos,

Diego.

jcc-tec · el 27 de febrero

Lo primero, muchas gracias por tu respuesta, me estoy volviendo loco de buscar ideas.

Sigo intentando modificar con lo que encuentro por ahí pero no lo consigo, adjunto fichero con 3 hojas, la primera tiene el contenido que he usado como muestra en la ubicación que estaría en el fichero de trabajo, a partir de la fila 7 puede ser un fichero con mas o menos contenido, yo para el ejemplo he usado solo 3 filas para no liarla, la única columna que me indica si hay que copiar es la que se llama código plano.

La segunda lo que me aparece a mi al ejecutar la macro "copiar filas" donde el contenido se coloca a partir de la fila 7 igual que en la hoja datos y la tercera hoja lo que realmente me gustaría que saliera donde la columna I seria el numero de copia de la cantidad solicitada. Si pido 4 copias, el primer bloque tendría el mismo valor que tenga la fila de la que copia, el segundo un ese valor+1 (En este caso 2), el tercero ese valor+2........ Quiero decir que si el fichero empezara con un 3 por ejemplo, el primer bloque de copia seria un 3 el segundo un 4......

Vaya jaleo me he montado en la cabeza y no se si me he explicado correctamente.

Test duplicar columnas.xlsm

DiegoLG · el 27 de febrero

Lo reviso , , en un rato te paso una solución

jcc-tec · el 27 de febrero

Eres una máquina, muchas gracias.

DiegoLG · el 28 de febrero

SI HOY NADIE TE DA SOLUCIÓN MAÑANA TE MANDO EL CÓDIGO ESTIMADO, ANDO MEDIO OCUPADON,

SALUDOS

JSDJSD · el 28 de febrero

Aquí tienes una posible solución

JSDJSD · el 28 de febrero

El archivo

Test duplicar columnas.xlsm

jcc-tec · el 28 de febrero

La verdad que un trabajo casi excelente, solo ha faltado, que en caso de empezar con un kit que no sea el 1, por ejemplo el 2, al pedir 3 copias, empiece por el 2 después el 3 y después el 4, voy a ver si lo consigo modificar o si te me puedes echar esta ultima mano genial, pero hasta aquí un trabajo y una ayuda excelente.

JSDJSD · el 28 de febrero

Cambia el código por este

Sub copiar(): Application.ScreenUpdating = False

    Hoja3.Range("A1", "A" & Hoja3.Range("B" & Rows.Count).End(xlUp).Row).EntireRow.Delete
    
    With Hoja1
        ufh = .Range("B" & Rows.Count).End(xlUp).Row
        arranque = .Range("I7")
        .Rows(6).Copy Hoja3.Range("A6")
        For cont = arranque To arranque + UserForm1.TextBox1.Value
            ufh1 = Hoja3.Range("B" & Rows.Count).End(xlUp).Row + 1
            .Range("A7", "I" & ufh).Copy Destination:=Hoja3.Range("A" & ufh1)
            For cont1 = 1 To 3
                Hoja3.Cells(Hoja3.Range("I" & Rows.Count).End(xlUp).Row - cont1 + 1, 9) = cont
            Next cont1
        Next cont
    End With
     UserForm1.ListBox1.RowSource = "'" & Hoja3.Name & "'!A6:I" & Hoja3.Range("B" & Rows.Count).End(xlUp).Row

End Sub

jcc-tec · el 28 de febrero

Finalmente lo he acoplado a mi fichero y me funciona excepto un pequeño detalle, como podría limitar la copia para que no poie nada de la columna I en adelante?

Asi me ha quedado en mi fichero:

Sub copiar(): Application.ScreenUpdating = False

Hoja6.Range("A7", "A" & Hoja6.Range("C" & Rows.Count).End(xlUp).Row).EntireRow.Delete

With Hoja7
ufh = .Range("C" & Rows.Count).End(xlUp).Row
arranque = .Range("I7")
.Rows(6).Copy Hoja6.Range("A6")
For cont = arranque To arranque + UserForm2.TextBox1.Value
ufh1 = Hoja6.Range("C" & Rows.Count).End(xlUp).Row + 1
.Range("A7", "I" & ufh).Copy Destination:=Hoja6.Range("A" & ufh1)
For cont1 = 1 To 3
Hoja6.Cells(Hoja6.Range("I" & Rows.Count).End(xlUp).Row - cont1 + 1, 9) = cont
Next cont1
Next cont
End With
UserForm2.ListBox1.RowSource = "'" & Hoja6.Name & "'!A6:I" & Hoja6.Range("C" & Rows.Count).End(xlUp).Row

End Sub

jcc-tec · el 28 de febrero

Tambien limitaria el borrado inicial para que no borre las filas enteras sino solo hasta la Columna I

jcc-tec · el 28 de febrero

Perdon que me he equivocado en el mensaje, lo que queria era limitar la copia en K aunque I sea el numero de copia. Estoy retocando el codigo poco a poco y me voy dando cuenta, asi es como lo tengo ahora:

Sub copiar(): Application.ScreenUpdating = False

Hoja6.Range("A7", "A" & Hoja6.Range("C" & Rows.Count).End(xlUp).Row).EntireRow.Delete

With Hoja7
ufh = .Range("C" & Rows.Count).End(xlUp).Row
arranque = .Range("I7")
.Rows(6).Copy Hoja6.Range("A6")
For cont = arranque To arranque + Hoja7.Range("A3")
ufh1 = Hoja6.Range("C" & Rows.Count).End(xlUp).Row + 1
.Range("A7", "I" & ufh).Copy Destination:=Hoja6.Range("A" & ufh1)
For cont1 = 1 To 3
Hoja6.Cells(Hoja6.Range("I" & Rows.Count).End(xlUp).Row - cont1 + 1, 9) = cont
Next cont1
Next cont
End With
Hoja6.Select
End Sub

jcc-tec · el 28 de febrero

Lo he conseguido, solo me falta una cosa, al hacerse las copias, las celdas que contienen el resultado de una formula, se copia la formula y provoca un jaleo, como podría cambiarlo para que la copia fuera solo de los valores?

Aquí esta como tengo el código ahora, muchísimas gracias por vuestra ayuda y perdonar el lio.

Sub copiar(): Application.ScreenUpdating = False

Hoja6.Range("A7", "A" & Hoja6.Range("C" & Rows.Count).End(xlUp).Row).EntireRow.Delete

With Hoja7
ufh = .Range("C" & Rows.Count).End(xlUp).Row
arranque = .Range("I7")
.Rows(6).Copy Hoja6.Range("A6")
For cont = arranque To arranque + Hoja7.Range("A3")
ufh1 = Hoja6.Range("C" & Rows.Count).End(xlUp).Row + 1
.Range("A7", "K" & ufh).Copy Destination:=Hoja6.Range("A" & ufh1)
For cont1 = 1 To 3
Hoja6.Cells(Hoja6.Range("I" & Rows.Count).End(xlUp).Row - cont1 + 1, 9) = cont
Next cont1
Next cont
End With
Hoja6.Select
End Sub

jcc-tec · el 28 de febrero

Conseguido, muchisimas gracias por la ayuda, sois unos maquinas.

Sub copiar(): Application.ScreenUpdating = False

Hoja6.Range("A7", "A" & Hoja6.Range("C" & Rows.Count).End(xlUp).Row).EntireRow.Delete

With Hoja7
ufh = .Range("C" & Rows.Count).End(xlUp).Row
arranque = .Range("I7")
.Rows(6).Copy Hoja6.Range("A6")
For cont = arranque To arranque + Hoja7.Range("A3")
ufh1 = Hoja6.Range("C" & Rows.Count).End(xlUp).Row + 1
.Range("A7", "K" & ufh).Copy
Hoja6.Range("A" & ufh1).PasteSpecial xlPasteValues
For cont1 = 1 To 3
Hoja6.Cells(Hoja6.Range("I" & Rows.Count).End(xlUp).Row - cont1 + 1, 9) = cont
Next cont1
Next cont
End With
Hoja6.Select
End Sub

JSDJSD · el 28 de febrero

Perfecto, me alegro

jcc-tec · el 1 de marzo

Perdonad que os moleste de nuevo, algo no termino de ver, hoy he adaptado el código y me funcionaba con la muestra que pusimos ayer, pero hoy con una tabla real, en concreto de 123 filas, resulta que el numero de copia solo me lo pone en 3 de ellas al final de cada duplicación pero en lo demás no, digamos que en si hago 2 copias, en las 123 filas de la primera copia, pone el valor inicial, pero a partir de ahí, solo le pone de las 123 filas de la segunda copia a las 3 ultimas un 2 y no veo el porque, me podéis echar una mano, por favor. Este es mi código, que funciona con 3 filas pero si pongo mas el Valor de la columna I solo se rellena en las ultimas 3 filas de cada copia cuando son mas de 3.

Sub copiar(): Application.ScreenUpdating = False

Hoja6.Range("A7", "A" & Hoja6.Range("C" & Rows.Count).End(xlUp).Row).EntireRow.Delete

With Hoja7
ufh = .Range("C" & Rows.Count).End(xlUp).Row
arranque = .Range("I7")
.Rows(6).Copy Hoja6.Range("A6")
For cont = arranque To arranque + Hoja7.Range("A3")
ufh1 = Hoja6.Range("C" & Rows.Count).End(xlUp).Row + 1
.Range("A7", "K" & ufh).Copy
Hoja6.Range("A" & ufh1).PasteSpecial xlPasteValues
For cont1 = 1 To 3
Hoja6.Cells(Hoja6.Range("I" & Rows.Count).End(xlUp).Row - cont1 + 1, 9) = cont
Next cont1
Next cont
End With
Hoja6.Select
End Sub

jcc-tec · el 1 de marzo

Es curioso, solo pone el numero de copia correcto si son 3 filas, con 2 tampoco y mi intención es que el numero de filas es variable, no se si será posible.

JSDJSD · el 1 de marzo

Prueba, este es para el último archivo que compartí, no el último código

Sub copiar(): Application.ScreenUpdating = False

    Hoja3.Range("A1", "A" & Hoja3.Range("B" & Rows.Count).End(xlUp).Row).EntireRow.Delete
    With Hoja1
        ufh = .Range("B" & Rows.Count).End(xlUp).Row
        .Rows(6).Copy Hoja3.Range("A6")
        For cont = 1 To UserForm1.TextBox1.Value
            ufh1 = Hoja3.Range("B" & Rows.Count).End(xlUp).Row + 1
            .Range("A7", "I" & ufh).Copy Destination:=Hoja3.Range("A" & ufh1)
            For cont1 = 1 To ufh - 6
                Hoja3.Cells(Hoja3.Range("I" & Rows.Count).End(xlUp).Row - cont1 + 1, 9) = cont
            Next cont1
        Next cont
    End With
     UserForm1.ListBox1.RowSource = "'" & Hoja3.Name & "'!A6:I" & Hoja3.Range("B" & Rows.Count).End(xlUp).Row

End Sub

JSDJSD · el 1 de marzo

Usando tu último código sería :

Sub copiar(): Application.ScreenUpdating = False

    Hoja6.Range("A7", "A" & Hoja6.Range("C" & Rows.Count).End(xlUp).Row).EntireRow.Delete
    
    With Hoja7
        ufh = .Range("C" & Rows.Count).End(xlUp).Row
        arranque = .Range("I7")
        .Rows(6).Copy Hoja6.Range("A6")
        For cont = arranque To arranque + Hoja7.Range("A3")
            ufh1 = Hoja6.Range("C" & Rows.Count).End(xlUp).Row + 1
            .Range("A7", "K" & ufh).Copy
            Hoja6.Range("A" & ufh1).PasteSpecial xlPasteValues
            For cont1 = 1 To ufh-6
                Hoja6.Cells(Hoja6.Range("I" & Rows.Count).End(xlUp).Row - cont1 + 1, 9) = cont
            Next cont1
        Next cont
    End With
Hoja6.Select
End Sub

jcc-tec · el 1 de marzo

No puedo nada mas que quitarme el sombrero, muchísimas gracias.

jcc-tec · el 1 de marzo

No te lo vas a creer, pero por algun motivo me pega cosas en la hoja1

jcc-tec · el 1 de marzo

Me encantaria mostrarte el fichero real pero con el limite de 100kb es imposible

Antoni · el 2 de marzo

hace 13 horas, jcc-tec dijo:

Me encantaria mostrarte el fichero real pero con el limite de 100kb es imposible

Elimina todos los datos, imágenes y cualquier tipo de objeto, deja el archivo solo con las hojas, comprímelo (.zip) e intenta subirlo otra vez.

jcc-tec · el 2 de marzo

No se porque ocupa tanto pero no me da, se me queda en 400kb y solo tiene las formulas y lo que son las macros, de todas maneras se lo he pasado a JSDJSD, quizás el encuentre el problema, muy agradecido de todas maneras.

Conéctate a Ayuda Excel

Copiar filas con datos varias veces segun valor y numerar copias

Recommended Posts

jcc-tec

DiegoLG

jcc-tec

DiegoLG

jcc-tec

DiegoLG

JSDJSD

JSDJSD

jcc-tec

JSDJSD

jcc-tec

jcc-tec

jcc-tec

jcc-tec

jcc-tec

JSDJSD

jcc-tec

jcc-tec

JSDJSD

JSDJSD

jcc-tec

jcc-tec

jcc-tec

Antoni

jcc-tec

Archivado

109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

1. ¿Te parecen útiles los tips de las funciones?

Ayúdanos a mejorar la comunidad

Archivos

Estadísticas de descargas

Mensajes

Visualizado recientemente

Navegar

Política privacidad

Información importante