Imprimir un duplicado de albarán desde una base de datos
En una aplicación casera, relleno la hoja de albarán, luego imprimo el albarán por duplicado y me ingresa los datos en una base de datos.
La cuestión es que me surge, imprimir de nuevo algún albarán y tengo que andar copiando y pegando datos .
Se puede hacer con una macro, y mediante un texbox para indicar el nº de albarán a imprimir duplicado.
Los números de albarán están en la hoja BDFACTURACION en la columna (E), los datos a copiar están desde la columna (G) a la columna (N), la fecha está el la columna (F) y el nombre del cliente en la columna (R).
La hoja donde ingresar los datos a imprimir es (COPIA ALBARAN).
En la celda (F2) tiene que aparecer el nombre del cliente.
En la celda (F5) tiene que aparecer la fecha original del albarán.
En la celda (F6) tiene que aparecer el número del albarán.
Los datos van a partir de la celda (A15)
Ésta macro me funciona, pero no se si es la más rápida, ya que está hecha de retales.
Sub Copia_Albaran()
Dim fila1 As Integer, filafinal As Integer, albaran As Integer, ultimo As Integer
Dim cliente As String
Dim fecha As Date
Set h1 = Sheets("COPIA ALBARAN")
Set h2 = Sheets("BDFACTURACION")
'-Si hay datos en la factura preguntar si se borran los datos
h1.Select
If h1.Range("F2:F2").Value <> "" Or h1.Range("F6:F6").Value <> "" Then
Validar = MsgBox("CONFIRMA BORRAR DATOS? ", vbOKCancel, "BORRADO DE DATOS")
If Validar = vbOK Then
h1.Select
h1.Range("Prim_Albaran").ClearContents
h1.Range("F2:F6").ClearContents
Application.ScreenUpdating = False
Else
Exit Sub
End If
End If
Application.ScreenUpdating = False
'Pregunta nº de albaran a duplicar
h1.Range("F6").Select
ActiveCell.Value = Val(InputBox("Nº Albaran", "Nº Albaran", "1", 14370, 5300))
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
albaran = Range("F6").Value
'Pasa a hoja (BDFACTURACION)
h2.Select
h2.Range("E5").Select
ultimo = h2.Range("E2").Value
'Confirma si existe el nº de albaran solicitado
If albaran > ultimo Or albaran = 0 Then
MsgBox "COMPRUEBE Nº DE ALBARAN" & Chr(10) & "ALBARAN NO EXISTE" & _
Chr(10) & Chr(10) & "NO PASO NADA", vbOKCancel, "NO HAY DATOS"
'Borra el nº ingrsado en F6 y que no existe o es (0)
h1.Range("F6").Value = ""
Application.CutCopyMode = False
Exit Sub
Else
'Coger direccion de la primera fila
While ActiveCell.Value <> albaran
ActiveCell.Offset(1, 0).Select
Wend
'Primera fila (fila1) del albaran
fila1 = ActiveCell.Row
'Guarda la fecha del albaran
fecha = ActiveCell.Offset(0, 1).Value
'Guarda el cliente del albarán
cliente = ActiveCell.Offset(0, 13).Value
'Coger direccion de la ultima fila
While ActiveCell.Value = albaran
ActiveCell.Offset(1, 0).Select
Wend
'Ultima fila del albaran
filafinal = ActiveCell.Offset(-1, 0).Row
'Copia los datos del albaran y los ingresa en hoja (COPIA ALBARAN) a partir de la fila 15
filapre = 15
h2.Range("G" & fila1 & ":N" & filafinal).Select
Selection.Copy
ActiveSheet.Paste Destination:=Sheets("COPIA ALBARAN").Cells(filapre, 1)
Application.CutCopyMode = False
'Rellena la celda de cliente
h1.Range("F2").Value = cliente
'Rellena la celda de la direccion del cliente mediante una busqueda
h1.Range("F3").FormulaR1C1 = _
"=VLOOKUP(R[-1]C, CLIENTES!R[-1]C[-3]:R[82]C[3], 5,0)"
h1.Range("F5").Value = fecha
'Guarda el libro
ActiveWorkbook.Save
h1.Select
Range("F2").Activate
Application.ScreenUpdating = True
End If
End Sub
