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

Respuesta
1

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

Ok amigo

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 sub


Esto 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 If

y funciona PEEERO; con la linea rw = .Range("R" &amp; .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 sub

Esto 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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas