Hoy quiero haceros la vida más fácil a aquellos que os dedicáis a realizar pedidos a proveedores por email y utilizáis Microsoft Excel.
Como ejemplo, voy a utilizar la consulta que me pasó nuestro amigo Sergio a través del foro. Se trata de una tabla de productos con varias columnas. La idea es agrupar los productos por proveedor, pero solo aquellos que en la columna "Realizar pedido" tengan un "Sí".
Crearemos una hoja por cada proveedor que tenga al menos un producto marcado en la lista y, posteriormente, enviaremos correos individuales a cada proveedor con el material a suministrar.
Todo de manera automática, claro.
Os dejo el código necesario que, a continuación, iremos desgranando para que quede totalmente claro.
Sub Macro()
Dim proveedor As String
'Desactivamos el refresco de pantalla para agilizar la macro
Application.ScreenUpdating = False
'Filtramos el listado y dejamos solo los que tienen SI tienen ENVIO DE PEDIDO
Dim data As Range
Dim criteria As Range
g = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
Set data = Range(Cells(1, "A"), Cells(g, "J"))
Set criteria = Range("M1:M2")
data.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=criteria, CopyToRange:=Range("AA1")
'Extraemos del listado los PROVEEDORES no repetidos y los ordenamos en la columna L
Set criteria = Range("N1:N2")
Range("L:L").ClearContents
Range("AB:AB").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=criteria, CopyToRange:=Range("L1"), Unique:=True
Range("L1:L1500").Sort Key1:=Range("L:L"), Order1:=xlAscending, Header:=xlYes
'Borramos los datos filtrados copiados anteriormente
Range(Cells(1, "AA"), Cells(g, "AJ")).Clear
'Identificamos la última fila de este listado para saber cuantos elementos tiene
f = Cells(Rows.Count, 12).End(xlUp).Offset(0, 0).Row
'Lanzamos un bucle en el que vamos a crear una hoja por cada proveedor a partir de la lista generada anteriormente, y en la que iremos añadiendo solo sus registros
For i = 2 To f
Sheets("Hoja1").Select
'Guardamos el número del proveedor en una variable
proveedor = Cells(i, "L")
'Creamos una hoja nueva para este proveedor
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = proveedor
Sheets("Hoja1").Select
'Copiamos el encabezado en la nueva hoja
Range(Cells(1, "A"), Cells(1, "J")).Select
Selection.Copy
Sheets(proveedor).Select
Cells(1, "A").Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks _
:=False, Transpose:=False
'Copiamos solo los registros de este proveedor que además SI tienen ENVIO DE PEDIDO, usando un bucle anidado
k = 2
For j = 2 To g
Sheets("Hoja1").Select
If Cells(j, "B") = proveedor And Cells(j, "H") = "SI" Then
Range(Cells(j, "A"), Cells(j, "J")).Select
Selection.Copy
Sheets(proveedor).Select
Cells(k, "A").Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks _
:=False, Transpose:=False
k = k + 1
End If
Next
'Total de articulos del proveedor
Sheets(proveedor).Select
Total = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
'Enviamos el correo al proveedor
Sheets(proveedor).Select
Set dam = CreateObject("outlook.application").createitem(0)
'Destinatario
dam.To = Cells(2, "G").Value
'Asunto
dam.Subject = "PEDIDO DE COMPRA : " & Cells(2, "J")
'Cuerpo del mensaje
cadena = ""
For m = 2 To Total
cadena = cadena & " " & Cells(m, "E") & " unidades " & Cells(m, "I") & " // "
Next
dam.body = "Buenos días " & vbCr & _
vbCr & _
"Por la presente, solicitamos el pedido de los siguientes productos " & cadena & vbCr & _
vbCr & _
"Necesitamos que nos indiquen la fecha aproximada de la entrega" & vbCr & _
vbCr & _
"Saludos cordiales"
dam.send
Next
End Sub
En primer lugar, utilizamos la función AdvancedFilter para filtrar la tabla y quedarnos solo con los productos que vamos a pedir, es decir, los que tienen un "Sí" en la columna "Realizar pedido".
Para no modificar la tabla original, copiamos la nueva tabla filtrada a partir de la columna AA.
Sub Macro()
Dim proveedor As String
'Desactivamos el refresco de pantalla para agilizar la macro
Application.ScreenUpdating = False
'Filtramos el listado y dejamos solo los que tienen SI tienen ENVIO DE PEDIDO
Dim data As Range
Dim criteria As Range
g = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
Set data = Range(Cells(1, "A"), Cells(g, "J"))
Set criteria = Range("M1:M2")
data.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=criteria, CopyToRange:=Range("AA1")
Ahora, volvemos a usar la función AdvancedFilter, pero esta vez para crear una lista única (sin duplicados) de proveedores con pedido a partir de esta última tabla.
El listado se muestra en la columna L correctamente ordenado. En este ejemplo, solo tenemos dos proveedores con pedido asignado, como puede comprobarse en la siguiente figura.
'Extraemos del listado los PROVEEDORES no repetidos y los ordenamos en la columna L
Set criteria = Range("N1:N2")
Range("L:L").ClearContents
Range("AB:AB").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=criteria, CopyToRange:=Range("L1"), Unique:=True
Range("L1:L1500").Sort Key1:=Range("L:L"), Order1:=xlAscending, Header:=xlYes
El siguiente paso es borrar la tabla filtrada generada anteriormente, y localizar la última fila con datos de la columna L para saber cuántos proveedores hay.
'Borramos los datos filtrados copiados anteriormente
Range(Cells(1, "AA"), Cells(g, "AJ")).Clear
'Identificamos la última fila de este listado para saber cuantos elementos tiene
f = Cells(Rows.Count, 12).End(xlUp).Offset(0, 0).Row
Es el momento de crear una hoja para cada proveedor, utilizando un bucle FOR y asignándole como nombre la del propio proveedor. Seguidamente, copiamos la fila de los encabezados de la tabla y, con otro bucle anidado, añadimos sus productos con pedido.
'Lanzamos un bucle en el que vamos a crear una hoja por cada proveedor a partir de la lista generada anteriormente, y en la que iremos añadiendo solo sus registros
For i = 2 To f
Sheets("Hoja1").Select
'Guardamos el número del proveedor en una variable
proveedor = Cells(i, "L")
'Creamos una hoja nueva para este proveedor
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = proveedor
Sheets("Hoja1").Select
'Copiamos el encabezado en la nueva hoja
Range(Cells(1, "A"), Cells(1, "J")).Select
Selection.Copy
Sheets(proveedor).Select
Cells(1, "A").Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks _
:=False, Transpose:=False
'Copiamos solo los registros de este proveedor que además SI tienen ENVIO DE PEDIDO, usando un bucle anidado
k = 2
For j = 2 To g
Sheets("Hoja1").Select
If Cells(j, "B") = proveedor And Cells(j, "H") = "SI" Then
Range(Cells(j, "A"), Cells(j, "J")).Select
Selection.Copy
Sheets(proveedor).Select
Cells(k, "A").Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks _
:=False, Transpose:=False
k = k + 1
End If
Next
Por último, enviamos los pedidos por email desde Excel, a través de OutLook. Para ello, calculamos el número de productos que lleva el pedido de cada proveedor y lo guardamos en la variable Total.
En el cuerpo del mensaje utilizamos otro bucle para ir añadiendo cada uno de los artículos con su cantidad.
'Total de articulos del proveedor
Sheets(proveedor).Select
Total = Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
'Enviamos el correo al proveedor
Sheets(proveedor).Select
Set dam = CreateObject("outlook.application").createitem(0)
'Destinatario
dam.To = Cells(2, "G").Value
'Asunto
dam.Subject = "PEDIDO DE COMPRA : " & Cells(2, "J")
'Cuerpo del mensaje
cadena = ""
For m = 2 To Total
cadena = cadena & " " & Cells(m, "E") & " unidades " & Cells(m, "I") & " // "
Next
dam.body = "Buenos días " & vbCr & _
vbCr & _
"Por la presente, solicitamos el pedido de los siguientes productos " & cadena & vbCr & _
vbCr & _
"Necesitamos que nos indiquen la fecha aproximada de la entrega" & vbCr & _
vbCr & _
"Saludos cordiales"
dam.send
Next
End Sub
Espero que te sirva este ejemplo para realizar pedidos a proveedores por email de manera automática utilizando Microsoft Excel.
Por último, quiero invitarte a compartir tus dudas en los comentarios o en el foro. Intentaré ayudarte en todo lo que pueda, y así aprenderemos todos.
Hasta la próxima.
Si te ha servido y quieres donar
Descarga el archivo del ejemplo
Últimas publicaciones
0 comentarios