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
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
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, 7) = [C14] 'DESCRIPCION
.Cells(rw, 6) = [E11] 'FECHA
Vere como implementar esa parte, pues mi experiencia es muy basica
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
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
Gracias RESUELTO