Registrar una compra con macro
Me gustaría registrar ciertos datos de mi compra a una hoja de compras a otra hoja de entradas.
Nº Compra, Fecha, Cod. Proveedor, Proveedor, Cod, Producto, Producto, Cantidad, Precio, Total
Por ese orden.
Te paso el libron al correo.
Un saludo y muchísimas gracias.
1 Respuesta
Respuesta de Dante Amor
1
Te anexo el código de entradas y de salidas actualizados
Sub RegistrarCompra()
'Por.Dante Amor
'Registra Compra en entradas, en stock y limpia el formulario
'
Application.ScreenUpdating = False
Set h1 = Sheets("STOCK")
Set h2 = Sheets("ENTRADAS")
Set h3 = Sheets("COMPRAS")
'
For i = 18 To 30
If h3.Cells(i, "B") = "" Then Exit For
Set b = h1.Columns("B").Find(h3.Cells(i, "C"), lookat:=xlWhole)
If Not b Is Nothing Then
'Actualiza stock
h1.Cells(b.Row, "O") = h1.Cells(b.Row, "O") + h3.Cells(i, "E")
End If
'Actualiza Entradas
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u2, "A") = h3.[B12]
h2.Cells(u2, "B") = h3.[B15]
h2.Cells(u2, "C") = h3.[F6]
h2.Cells(u2, "D") = h3.[F7]
h2.Cells(u2, "E") = h3.Cells(i, "C")
h2.Cells(u2, "F") = h3.Cells(i, "D")
h2.Cells(u2, "G") = h3.Cells(i, "E")
h2.Cells(u2, "H") = h3.Cells(i, "F")
h2.Cells(u2, "I") = h3.Cells(i, "E") * h3.Cells(i, "F")
Next
'Limpia formulario
h3.Range("F7").ClearContents
h3.Range("D18:E30").ClearContents
h3.Range("F7").Select
Application.ScreenUpdating = True
MsgBox "Compra registrada"
End SubSub RegistrarVenta()
'Por.Dante Amor
'Registra Venta, en stock y limpia el formulario
'
Application.ScreenUpdating = False
Set h1 = Sheets("STOCK")
Set h2 = Sheets("SALIDAS")
Set h3 = Sheets("VENTAS")
'
exitosa = True
For i = 18 To 30
If h3.Cells(i, "B") = "" Then Exit For
Set b = h1.Columns("B").Find(h3.Cells(i, "C"), lookat:=xlWhole)
If Not b Is Nothing Then
'valida stock
If h1.Cells(b.Row, "O") < h3.Cells(i, "E") Then
exitosa = False
Exit For
End If
Else
errorart = True
Exit For
End If
Next
If errorart Then
MsgBox "Código de artículo no encontrado" & h3.Cells(i, "C")
Exit Sub
Else
If exitosa Then
'Actualiza stock
For i = 18 To 30
If h3.Cells(i, "B") = "" Then Exit For
Set b = h1.Columns("B").Find(h3.Cells(i, "C"), lookat:=xlWhole)
If Not b Is Nothing Then
h1.Cells(b.Row, "O") = h1.Cells(b.Row, "O") - h3.Cells(i, "E")
End If
'Actualiza salidas
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u2, "A") = h3.[B12]
h2.Cells(u2, "B") = h3.[B15]
h2.Cells(u2, "C") = h3.[F7]
h2.Cells(u2, "D") = h3.[F8]
h2.Cells(u2, "E") = h3.Cells(i, "C")
h2.Cells(u2, "F") = h3.Cells(i, "D")
h2.Cells(u2, "G") = h3.Cells(i, "E")
h2.Cells(u2, "H") = h3.Cells(i, "F")
h2.Cells(u2, "I") = h3.Cells(i, "E") * h3.Cells(i, "F")
Next
Else
MsgBox "Inventario insuficiente, para el artículo: " & h3.Cells(i, "C")
Exit Sub
End If
End If
'Limpia formulario
h3.Range("F8").ClearContents
h3.Range("D18:E30").ClearContents
h3.Range("F8").Select
Application.ScreenUpdating = True
MsgBox "Venta registrada"
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
