Corregir macro para que no escriba en filas especificas

Tengo un detalle con esta fórmula. La fila A41 me indica el limite de una hoja así que le escribí algo para que brinque esa fila al momento de copiar ya que se supone que la macro busca la fila siguiente que este vacía, lo mismo hice en la fila A81 y las deje bloqueadas para que no me las borrara al momento de hacer la copia pero ahorita ya no me funciona así. Supongamos que quiero copiar 45 veces ahí se va de corrido y escribe en A41 aunque tenga escrito algo. Esta es la fórmula que utilizo

Sub copiar()
'opcional: verifica que se esté seleccionando rango en A:C
Sheets("PRODUCTOS").Select
ActiveSheet.Unprotect Password:="contraseña"
If Selection.Row = 1 Or Selection.Column > 3 Or Selection.Count > 3 Then Exit Sub
'ubica la siguiente fila libre y pega la selección
filx = Range("A2").CurrentRegion.Rows.Count + 1
Range("A" & ActiveCell.Row & ":C" & ActiveCell.Row).Copy Destination:=Range("A" & filx & ":A" & filx + [E2] - 1)
Sheets("PRODUCTOS").Select
ActiveSheet.Protect Password:="contraseña"

End Sub

1 Respuesta

Respuesta
1

Te dejo la nueva macro. Probala y me comentás.

Sub copiarNvo()
'x Elsamatilde
'opcional: verifica que se esté seleccionando rango en A:C
Sheets("PRODUCTOS").Select
[A11].Select
ActiveSheet.Unprotect Password:="contraseña"
If Selection.Row = 1 Or Selection.Column > 3 Or Selection.Count > 3 Then Exit Sub
'se ejecuta si en E2 hay un valor numérico
If Val([E2]) = 0 Then Exit Sub
'guarda la primer fila libre
filx = Range("A2").CurrentRegion.Rows.Count
tot = 0
'repite el bucle hasta llegar a copiar el total de filas indicadas en E2
While tot < [E2]
    dif = [E2] - 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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas