Corrección de Macro que copie y pegue Las veces indicadas

Recibida tu consulta. Ya te prepararé el nuevo código ajustado.

'....Es el limite hasta donde puede copiar esto lo hice porque es el tamaño de una hoja tamaño carta....'

Esto me hace pensar que no estás utilizando los saltos de página.

En Excel no dejamos filas sino que configuramos la hoja para indicarle dónde hacer el salto. Observa en la imagen. Presionando el botón marcado al pie, se ajustan las filas que necesitas mostrar en cada hoja. Si la línea de guiones no cae entre fila 40 y 41, la debes arrastrar hasta ubicarla como te la marco de rojo. Lo mismo con el resto.

Y eso es todo lo que necesitas, sin necesidad de dejar filas en blanco que te pueden complicar a la hora de filtrar, ordenar, encontrar fin de rango, etc.

Así que desbloquea esas filas, que corra la macro y luego ajustá los saltos de página.

Si esto resuelve tu problema no olvides valorar la respuesta.

Si por alguna otra razón necesitas de todos modos realizar ese salto me avisas.

Sdos!

Hola buenas tardes. Gracias por el dato lo voy a aplicar para mis próximos libros, pero hacerlo ahorita seria reconfigurar todo lo que tengo ya hecho. Si me pudiera hacer el favor de ayudarme a hacer el salto se lo agradecería mucho. esta macro me la hizo también usted y es la que uso actualmente y en esta si me hace el salto nada mas que no copia como yo quiero. Saludos

 Sub COPIAR()
'x Elsamatilde
'opcional: verifica que se esté seleccionando rango en A:C
Sheets("PRODUCTOS").Select
ActiveSheet.Unprotect Password:="contraseña"
COPIAS = InputBox("Cuantas Copias?", "AVISO")
Range("D2") = COPIAS
If Selection.Column - 5 Then Exit Sub
'se ejecuta si en D2 hay un valor numérico
If Val([D2]) = 0 Then Exit Sub
'guarda la primer fila libre
filx = Range("A2").CurrentRegion.Rows.Count
tot = 1
'repite el bucle hasta llegar a copiar el total de filas indicadas en D2
While tot < [D2]
dif = [D2] - tot 'cuántas filas faltan
x = Range("A" & filx).End(xlDown).Row - 1 'fin del sgte rango
If x > filx + dif Then x = filx + dif
Range("A" & ActiveCell.Row & ":C" & ActiveCell.Row).Copy Destination:=Range("A" & filx + 1 & ":A" & x)
tot = tot + (x - filx) 'cuántos ya pasé
filx = x + 1
Wend
Sheets("PRODUCTOS").Select
ActiveSheet.Protect Password:="contraseña"
End Sub

Qué pena con el foro... últimamente no están enviando avisos. Espero te llegue esta respuesta (también te la estoy enviando a tu correo)

Ajusté la macro original, la de la respuesta anterior. Estoy considerando que no se puede copiar más allá de la 120 como mencionaste. Si necesitas al libro con el ejemplo podes solicitarlo a mi correo.

Sub rellenando()
'x Elsamatilde
'busca el fin de rango
x = Range("E" & Rows.Count).End(xlUp).Row
'compruebo que haya datos
If x = 1 Then
    MsgBox "No hay datos para copiar."
    Exit Sub
End If
'primer fila destino
a = x + 1
'recorre col E hasta el último dato
For i = 2 To x
    'si es > 1 copia la fila
    If Range("E" & i) > 1 Then
        'cantidad a copiar
        b = Range("E" & i) - 1
        If a + b <= 40 Then
            Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + b - 1)
        ElseIf a <= 40 Then
            canti = 40 - a
            'copia algunos reg en primer tramo destino
            Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + canti)
            'los q faltan copiar
            b = b - canti - 1
            a = 42
            If a + b <= 80 Then
                Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + b - 1)
            Else
                canti = 80 - a
                'copia algunos reg en primer tramo destino
                Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + canti)
                'los q faltan copiar
                b = b - canti - 1
                a = 82
                If a + b <= 120 Then
                    Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + b - 1)
                Else
                    canti = 80 - a
                    'copia algunos reg en primer tramo destino
                    Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + canti)
                End If
            End If
        ElseIf a + b <= 80 Then
            Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + b - 1)
        ElseIf a <= 80 Then
            'copia algunos reg en primer tramo destino
            canti = 80 - a
            Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + canti)
            'los q faltan copiar
            b = b - canti - 1
            a = 82
            If a + b <= 120 Then
                Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + b - 1)
            End If
        ElseIf a + b <= 120 Then
            Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + b - 1)
        ElseIf a <= 120 Then
            canti = 120 - a
            Range("A" & i & ":C" & i).Copy Destination:=Range("A" & a & ":C" & a + canti)
        'no hay + lugar
        End If
    End If
    'incrementa la fila destino
    a = Range("A" & Rows.Count).End(xlUp).Row + 1
Next i
'opcional: enviar mensaje de fin
MsgBox "Fin del proceso."
End Sub

Sdos y no olvides valorar la respuesta.

Elsa

Hola. Ya probé la macro y ya hace el salto, el detalle ahora es que nada más copia las cantidades de E2 y las de E3 y E4 no.

Esta imagen es de la otra macro, esta si hace la función de copiado nada más le falta hacer el salto. Si gusta le puedo enviar el libro para que lo revise

Si, enviámelo. Porque en mis pruebas funciona correctamente. Podés utilizar el correo cibersoft. Arg de gmail también.

Sdos!