Codigo para copiar Factura a otra hoja

6 envíos / 0 nuevos
Último envío
JoaoM
Imagen de JoaoM
Offline
última acción: Hace 1 mes 1 semana
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntos
alta: 15/12/2011 - 23:46
Puntos: 2950
Codigo para copiar Factura a otra hoja

Resulta que tengo este código para que por medio de un botón, me copie de Hoja Factura hacia hoja Copias_Factura pero, ¿qué pasa? es que copia solo el 1º renglón de la factura ripitiendolo tantas veces como productos tengo en la factura. Si tengo 2 Productos para facturar, solo copia el 1º pero repitiéndolo 2 veces si tengo 10 repite el 1º 10 veces

CÓDIGO:
Sub macro_Copia_Factura() 'Para copiar LA hoja7 a otra
On Error Resume Next

With Sheets("Copias_Factura")
ref_fila = .Range("f10000").End(xlUp).Row + 1
For a = 14 To 23
If Cells(a, 2) <> "" Then
rw = .Range("f10000").End(xlUp).Row + 1
For b = 0 To 4
.Cells(rw, b + 6) = Cells(a, b + 2)
Next b
.Cells(rw, 1) = [C7] 'RIF/CI
.Cells(rw, 2) = [C8] 'NOMBRE
.Cells(rw, 3) = [C9] 'DIRECCION
.Cells(rw, 4) = [B10] 'CIUDAD
.Cells(rw, 5) = [C11] 'TELF.
.Cells(rw, 6) = [E11] 'FECHA
.Cells(rw, 7) = [C14] 'DESCRIPCION
.Cells(rw, 8) = [E14] 'CANTIDAD
.Cells(rw, 9) = [D14] 'Precio/U/Venta
.Cells(rw, 10) = [F14] 'VALOR
End If

Next a

If ref_fila > 2 Then .Cells(ref_fila, 1).EntireRow.Insert
End With

MsgBox "Copia exitosa", vbInformation, "Copia"
Exit Sub
End Sub

Se pueden facturar 10 productos como solo uno o 2 (son 10 líneas) .La factura

 Me deja la copia así

h**p://i57.tinypic.com/2hdwv8z.jpg

 y debe ser así

h**p://i62.tinypic.com/1zxo5rd.jpg

 No estoy dejando el libro por el peso y tendría que eliminar código y hojas y forms que se relacionan entre si.
Por tal motivo pido mis disculpas al moderador y administración por este detalle.

Algún detalle requerido, estaré en el cuadro prevenido al bate

PD: Podría hacerse para que siendo la misma factura, el nombre y demas que son lo mismo, no se repitiera la parte de A hasta F dejando esa parte solo con la 1ª línea una vez que es la misma factura y para nueva copia en vez de buscar la ultima línea ocupada por A buscar por G para que deje una línea de espacio entre opias de facturas. No se si me pude explicar

 

NO deja ver las imagenes en su tamaño en que fueron subidas
Gracias

Creí_que_sabía_Excel
Imagen de Creí_que_sabía_Excel
Offline
última acción: Hace 6 años 10 meses
alta: 11/04/2014 - 18:36
Puntos: 95
Re: Codigo para copiar Factura a otra hoja

Con

For b = 0 To 4

.Cells(rw, b + 6) = Cells(a, b + 2)

Next b

Copias los valores que quieres, en las columnas 6,7,8,9 y 10,

Pero después, al poner:

.Cells(rw, 6) = [E11] 'FECHA
.Cells(rw, 7) = [C14] 'DESCRIPCION
.Cells(rw, 8) = [E14] 'CANTIDAD
.Cells(rw, 9) = [D14] 'Precio/U/Venta
.Cells(rw, 10) = [F14] 'VALOR
Copias encima los valores de la primera línea de la factura (que según parece es la 14)
Si no quieres repetir valores, siempre podrías hacer una comparación, para evitar copiarlos, tipo 
if a=14 then 
.Cells(rw, 1) = [C7] 'RIF/CI
.Cells(rw, 2) = [C8] 'NOMBRE
.Cells(rw, 3) = [C9] 'DIRECCION
.Cells(rw, 4) = [B10] 'CIUDAD
.Cells(rw, 5) = [C11] 'TELF.
.Cells(rw, 6) = [E11] 'FECHA
endif
Y sólo lo copiaría cuando a=14, en el resto del caso no.
Un saludo
 
visitante (no verificado)
Imagen de visitante
Re: Codigo para copiar Factura a otra hoja

Vere como implementar esa parte, pues mi experiencia es muy basica

JoaoM
Imagen de JoaoM
Offline
última acción: Hace 1 mes 1 semana
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntos
alta: 15/12/2011 - 23:46
Puntos: 2950
Re: Codigo para copiar Factura a otra hoja

 Gracias por responder y darme una solucion pero, no fui capaz de implementar esa parte, eror tras error y nada.

Mi experiencia es muy basica

Creí_que_sabía_Excel
Imagen de Creí_que_sabía_Excel
Offline
última acción: Hace 6 años 10 meses
alta: 11/04/2014 - 18:36
Puntos: 95
Re: Codigo para copiar Factura a otra hoja

Joao, el código no tiene mucha más ciencia, te lo paso comentando los cambios

 

Sub macro_Copia_Factura() 'Para copiar LA hoja7 a otra

'Yo, personalmente, a no ser que busque un error, evito este tipo de instrucciones

'On Error Resume Next

 

With Sheets("Copias_Factura")

' ref_fila, última línea con valor en la columna , cambialó a la columna G, ya que la F contiene la fecha

ref_fila = .Range("G10000").End(xlUp).Row + 1

 

For a = 14 To 23

'Añadimos el atributo .Value a la celda, lo que queremos es si la celda no está en blanco

' En general, sin atributo se referirá a la celda, pero puede darte problemas

If Cells(a, 2).Value <> "" Then

'Te vuelvo a cambiar la F por la G

rw = .Range("G10000").End(xlUp).Row + 1

'Por seguir un orden, primero copia estos datos

If a = 14 Then   'Si quieres que te repitan estos datos, quita esta linea

    .Cells(rw, 1) = [C7] 'RIF/CI

    .Cells(rw, 2) = [C8] 'NOMBRE

    .Cells(rw, 3) = [C9] 'DIRECCION

    .Cells(rw, 4) = [B10] 'CIUDAD

    .Cells(rw, 5) = [C11] 'TELF.

    .Cells(rw, 6) = [E11] 'FECHA

End If  ' Si quieres que te siga repitiendo los datos quita esta línea

'Después los de los productos He cambiado el for de b=0 to 4 a b=1 to 5, y

'En consecuencia, las columnas de la a

    For b = 1 To 4

    'En la columna F (7) copio lo que hay en la hoja activa de la celda 14,2 (B14)

    'En la columna G (8) copio lo que hay en la hoja activa de la celda 14,3 (C14)

    '...... (observa que he puesto Value después de la celda, para que copie el valor, no todas las características (formatos y demás

        .Cells(rw, b + 6).Value = Cells(a, b + 1).Value

    Next b

'Elimino las siguientes instrucciones (al comentarlas con el ' es como si no existieran, las puedes eliminar directamente:

'    .Cells(rw, 7) = [C14] 'DESCRIPCION

'    .Cells(rw, 8) = [E14] 'CANTIDAD

'    .Cells(rw, 9) = [D14] 'Precio/U/Venta

'    .Cells(rw, 10) = [F14] 'VALOR

End If

 

Next a

'Esto nos inserta una fila. Lo que estamos haciendo es para separar los datos de los existentes anteriormente

If ref_fila > 2 Then .Cells(ref_fila, 1).EntireRow.Insert

End With

'vbInformation te define el tipo de MsgBox que te sale, "Copia" es el título y "Copia existosa" es el mensaje 

MsgBox "Copia exitosa", vbInformation, "Copia"

'Eliminamos Exit Sub (No queda elegante), Para qué salirte si ya has acabado

'Exit Sub

End Sub

JoaoM
Imagen de JoaoM
Offline
última acción: Hace 1 mes 1 semana
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntos
alta: 15/12/2011 - 23:46
Puntos: 2950
Gracias  RESUELTO

Gracias  RESUELTO