MACRO Agregar lista de materiales a las ventas detalladas.
Ayúdeme como hacer una MACROS para esta TAREA REPITIVA
En el listado libro “VENTA DETALLADA”, he agregado una columna “Nro_PARTE”, con la letra “N”, que son los códigos (Columna “C”) a los que tengo que agregar su lista de materiales, la búsqueda de materiales se hace en el libro “MATERIALES POR PT”, si no se encuentra el código quizás se trate de una venta de “Mercadería”, ¿en ese caso colocar “AVERIGUAR?”.
El resultado lo vemos en el libro “MATERIALES POR VENTA”, donde la Columna E “Nro_FILAS” indica el NUMERO DE FILAS QUE SE TIENEN QUE AGREGAR EN ESE CÓDIGO VENDIDO, luego en la Columna F “Nro_PARTE”, se reempaza “N” por “TITULO” y se agrega los números sucedivos del 1 al n (n = ultima fila), haciendo la búsqueda en el libro “MATERIALES” que cumplan con tener el código y el numeral para copiar los datos desde CODART hasta Consumo, MATERIALES=consumo POR CantVenta y copiar FACTURA y FECHA (las copias tienen fondo AZUL)
Gracias JOHNMOR41 - PERU
1 respuesta
Estimado Dante Amor
Acabo de enviarte un correo desde mi cuenta [email protected], con el archivo de excel
Realmente admiro el interes que pones a cada una de tus respuestas, y otra vez muchas gracias por compartir tus conocimientos
saludos, JOHNMOR41 - PERU
Te anexo la macro
Sub MaterialesXVenta()
'Por.Dante Amor
Set h1 = Sheets("VENTA DETALLE")
Set h2 = Sheets("MATERIALES")
Set h3 = Sheets("MATERIALES X VENTA")
u3 = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row
If u3 = 1 Then u3 = 2
h3.Range("A2:Z" & u3).Clear
j = 2
'
For i = 2 To h1.Range("C" & Rows.Count).End(xlUp).Row
nro = 0
cod = h1.Cells(i, "C")
generales h1, h3, i, j
unicos h1, h3, i, j
j1 = j
j = j + 1
Set r = h2.Columns("A")
Set b = r.Find(cod, lookat:=xlWhole)
If Not b Is Nothing Then
ncell = b.Address
Do
nro = nro + 1
generales h1, h3, i, j
h3.Cells(j, "F") = Format(nro, "00")
h3.Cells(j, "G") = h2.Cells(b.Row, "E")
h3.Cells(j, "H") = h2.Cells(b.Row, "F")
h3.Cells(j, "I") = h2.Cells(b.Row, "G")
h3.Cells(j, "J") = h2.Cells(b.Row, "H")
h3.Cells(j, "K") = h2.Cells(b.Row, "I")
h3.Cells(j, "N") = h3.Cells(j, "K") * h3.Cells(j, "M")
j = j + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
h3.Cells(j1, "E") = nro
h3.Cells(j1, "F") = "TITULO"
End If
Next
h3.Select
lineas
MsgBox "Agregar lista de materiales a las ventas detalladas", vbInformation, "TERMINADO"
End Sub
Sub generales(h1, h3, i, j)
'Por.Dante Amor
h1.Range("A" & i & ":D" & i).Copy h3.Range("A" & j)
h1.Range("E" & i).Copy h3.Range("L" & j)
h1.Range("L" & i).Copy h3.Range("M" & j)
h1.Range("J" & i).Copy h3.Range("P" & j)
h1.Range("K" & i).Copy h3.Range("Q" & j)
End Sub
Sub unicos(h1, h3, i, j)
'Por.Dante Amor
H1.Range("G" & i). Copy h3.Range("O" & j)
H1.Range("M" & i). Copy h3.Range("R" & j)
H1.Range("N" & i). Copy h3.Range("S" & j)
H1.Range("O" & i). Copy h3.Range("T" & j)
H1.Range("P" & i). Copy h3.Range("U" & j)
End Sub
Sub lineas()
Range("A2", ActiveCell.SpecialCells(xlLastCell)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
¡Gracias!
Dante Amor, lo volviste a lograr, reduciste mi trabajo que me tomaba días (osea el proceso de agregar materiales a las ventas) en solo apretar un botón, ERES UN GENIO. Solo un comentario efectivamente puse N en la cabecera "Nro_PARTE" para saber que "codigos" tenia pendiente de encontrar su lista de materiales, algo así como un contador, que hiciera que el procedimiento continué hasta que no quede ningún "codigo" con la letra "N" osea todos se volvieran "TITULO" .
Saludos y eternamente agradecido, JOHNMOR41 - PERÚ
