Adaptar macro o crerar rutina en Excel VBA
Dante Aquí vi unas macros tuyas que me parecieron que se podría adaptar a lo que necesito, (creo).
Esta hoja = "Copia_Factura"

Que recibe de esta macro
Aqui iria la macro pero me dice que son demasiados caracteres
¿Será qué puedes agregar una rutina en determinado punto que también lo que viene de la C7 de hoja “Factura” pegado en B en la With Sheets("Copias_Factura") repita el pegado en R pero una debajo de la anterior? ¿A partir de R2? Sin vacías entremedias, o entonces un evento
Sub Copia_R()
‘Aquí rutina para que pegue en R de la Hoja “Copia_Factura” lo copiado de la C7 de hoja “Factura” una debajo de otra a partir R2 SIN que queden líneas vacías entremedias
End Sub
Para que se vea así en la hoja Copia_Factura columna R
Hoja Copia_Factura Columna B
Se ve así --------->>>>>>>>>>>>>>>>>>>>>>>>>>>>> En columna R verla así

Luego yo aplico un Call Copia_R a la anterior macro
¿Se podrá?
1 Respuesta
H o l a:
Envíame un archivo con la macro que comentas y ahí me explicas el ejemplo. Recuerda poner tu nombre de usuario en el asunto.
Aquí la macro para que agregar rutina para que además de estar haciéndolo hacia la hoja Copia_Factura, REPITA la pega SOLO de C7 a la columna R de Hoja Copia_Factura, pero sin líneas vacías entremedias a partir de R3
Ahora por demasadas mayúsculas no deja agreagr
En el archivo que te envíe, esta un modulo llamado: Inicio_Print_Copia
En ese modulo esta una macro evento: Sub Copia_Factura(Optional POR As Long)
En esta macro quiero agregar una rutina para que independientemente de lo que hace la macro, envíe el dato de C7 de hoja Factura a la columna R de la hoja Copia_Factura, cada ves que se ejecute la macro: Sub Copia_Factura(Optional POR As Long), un dato debajo del otro, como se ve en la ultima imagen de arriba. Esta macro es llamada desde la macro para imprimir por medio de un Call Copia_Factura.
En pocas palabras: el dato de C7 De hoja7 sea TAMBIÉN pegado en R de la hoja8. Partiendo de R2
Te anexo la macro actualizada
sub copia_factura(optional x as long) 'para copiar la hoja7 a copias_factura
dim rw as long 'valida de fila
dim a as integer 'valida del bucle
dim i as long 'valida para contar numero de producto
dim u as long 'valida para contar numero de productos
on error resume next
with sheets("copias_factura")
'tomamos la última fila usada en la columna f de la hoja donde f guardar factura
rw = .range("h" & .rows.count).end(xlup)(2).row
'si la fila es superior a la 2 añadir una fila para separar los datos almacenados
if rw > 2 then rw = rw + 1
'contabilizar es el número de los datos que se deben de almacenar
u = worksheetfunction.counta(range("b14:b23"))
'iniciamos el conteo
i = 1
'bucle por las filas de los datos donde se crean los codigos en la factura
for a = 14 to 23
'verificamos que exista un dato en la columna cód prod
if range("b" & a) <> "" then
'añadimos los datos del array
select case i
case 1:
'#factura - rif/ci - nombre - direccion - ciudad - telf -
'fecha - descripcion - cantidad - precio/u/venta - valor
.range("a" & rw & ":k" & rw) = array(range("b3"), range("c7"), range("c8"), _
range("c9"), range("b10"), _
range("c11"), cdate(range("e11")), _
range("c" & a), range("e" & a), _
range("d" & a), range("f" & a))
if i = u then
'descripcion - cantidad - precio/u/venta - valor - iva - total
.range("h" & rw & ":m" & rw) = array(range("c" & a), range("e" & a), _
range("d" & a), range("f" & a), _
range("f26"), range("f27"))
end if
case u
'descripcion - cantidad - precio/u/venta - valor - iva - total
.range("h" & rw & ":m" & rw) = array(range("c" & a), range("e" & a), _
range("d" & a), range("f" & a), _
range("f26"), range("f27"))
case else
'descripcion - cantidad - precio/u/venta - valor
.range("h" & rw & ":k" & rw) = array(range("c" & a), range("e" & a), _
range("d" & a), range("f" & a))
end select
'poner número de factura
.range("r" & rw) = range("c7")
'se añade una nueva fila para el siguiente bucle
rw = rw + 1
i = i + 1
end if
next a
end with
'lanzamos mensaje de alerta de finalización de copia
msgbox "copia de factura hecha con éxito", vbinformation, "copia"
exit sub
end subEsto es la parte que le agregué:
'Poner número de factura
.Range("R" & rw) = Range("C7")![]()
Hola Dante, un deseo de buena semana.
Funciona si pero, ¿cómo hacer, o que agregar para que comience a pegar de la R2 hacia abajo sin que en R deje espacios vacíos?

Bueno, le agregue esto para que pegue uno debajo del ultimo existente
'Poner número de factura
'''''''''''''''
'Para que no le agregue lineas vacias entremedias al pegar
''Quitado de aqui
'''''''''''''''
'SE AÑADE UNA NUEVA FILA PARA EL SIGUIENTE BUCLE
rw = rw + 1
i = i + 1
''''''''
'Colocado aqui
rw = .Range("R" & .Rows.Count).End(xlUp)(2).Row
.Range("R" & rw) = Range("C7")
''''''''
End Ify funciona PEEERO; con la linea rw = .Range("R" & .Rows.Count).End(xlUp)(2).Row
De solo una factua, repite el valor de C7 tantas las veces como itens facturados, si facturo 1 uno pega en R si facturo 5 5 pega en R.
Cambie en la linea, el 2 a 1 y pega uno pero SIEMPRE mantiene la cantidad que ya existia en R, si 8 celdas ocupadas 8 mantiene porque subescribe el ultimo con el nuevo que entra.
Cada factura es un solo cliente, por eso tiene que solo pegar una ves el dato de C7 del cliente facturado

¿Nueva pregunta? Dime
Así:
sub copia_factura(optional x as long) 'para copiar la hoja7 a copias_factura
dim rw as long 'valida de fila
dim a as integer 'valida del bucle
dim i as long 'valida para contar numero de producto
dim u as long 'valida para contar numero de productos
on error resume next
with sheets("copias_factura")
'tomamos la última fila usada en la columna f de la hoja donde f guardar factura
rw = .range("h" & .rows.count).end(xlup)(2).row
'si la fila es superior a la 2 añadir una fila para separar los datos almacenados
if rw > 2 then rw = rw + 1
'contabilizar es el número de los datos que se deben de almacenar
u = worksheetfunction.counta(range("b14:b23"))
'iniciamos el conteo
i = 1
'bucle por las filas de los datos donde se crean los codigos en la factura
for a = 14 to 23
'verificamos que exista un dato en la columna cód prod
if range("b" & a) <> "" then
'añadimos los datos del array
select case i
case 1:
'#factura - rif/ci - nombre - direccion - ciudad - telf -
'fecha - descripcion - cantidad - precio/u/venta - valor
.range("a" & rw & ":k" & rw) = array(range("b3"), range("c7"), range("c8"), _
range("c9"), range("b10"), _
range("c11"), cdate(range("e11")), _
range("c" & a), range("e" & a), _
range("d" & a), range("f" & a))
if i = u then
'descripcion - cantidad - precio/u/venta - valor - iva - total
.range("h" & rw & ":m" & rw) = array(range("c" & a), range("e" & a), _
range("d" & a), range("f" & a), _
range("f26"), range("f27"))
end if
case u
'descripcion - cantidad - precio/u/venta - valor - iva - total
.range("h" & rw & ":m" & rw) = array(range("c" & a), range("e" & a), _
range("d" & a), range("f" & a), _
range("f26"), range("f27"))
case else
'descripcion - cantidad - precio/u/venta - valor
.range("h" & rw & ":k" & rw) = array(range("c" & a), range("e" & a), _
range("d" & a), range("f" & a))
end select
'poner número de factura
set b = .range("r:r").find(range("c7"), lookat:=xlwhole)
if b is nothing then
ufila = .range("r" & rows.count).end(xlup).row + 1
.range("r" & ufila) = range("c7")
end if
'se añade una nueva fila para el siguiente bucle
rw = rw + 1
i = i + 1
end if
next a
end with
'lanzamos mensaje de alerta de finalización de copia
msgbox "copia de factura hecha con éxito", vbinformation, "copia"
exit sub
end subEsto es lo que agregué
'Poner número de factura
Set b = .Range("R:R").Find(Range("C7"), lookat:=xlWhole)
If b Is Nothing Then
ufila = .Range("R" & Rows.Count).End(xlUp).Row + 1
.Range("R" & ufila) = Range("C7")
End If![]()
- Compartir respuesta