Enviar Diferentes Rangos a diferentes Destinatarios
Tengo una Hoja excel en la que por las mañanas copio los pedidos pendientes de los proveedores. En otra hoja del mismo Excel, tengo todos los datos de los proveedores con email y código de proveedor.
Actualmente utilizo una hoja donde con BUSCARV al poner el código del proveedor me devuelve su email y concatena su nombre en el asunto del email, además la macro envía lo que selecciono manualmente en el excel por correo, me lo pone en el cuerpo del email y no como mensaje.
Es práctico, pero demasiado manual, me gustaría que pulsando la macro automáticamente buscara por los códigos de proveedor y envíe sus filas correspondientes.
Como verán en la imagen en la celda E3, escribo el código de proveedor y me devuelve el nombre y su correo.
En la A6 se concatena la F1 y la E4 que es el nombre del proveedor. Así cuando selecciono por ejemplo el range A6:O13 y pulso ENVIAR CORREO se envía la información de la selección.
La macro usada es esta, no se si valdrá creo que no. Yo creo que lo que hay que ir haciendo es filtando por ID de proveedor, haciendo a la vez un BuscarV para devolver el correo correcto, enviar y así sucesivamente, pero no se hacerlo la verdad!
Sub Enviar_Rango_a_Destinatario_de_correo()
ActiveSheet.Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Item.To = ThisWorkbook.Sheets("Resumen").Range("E5").Value
.Item.cc = "[email protected]" 'con copia a...
'.Item.bcc = "[email protected]" 'con copia oculta a...
.Item.Subject = ThisWorkbook.Sheets("Resumen").Range("A6").Value
.Introduction = ""
.Item.Send
End With
End Sub
1 respuesta
Te anexo la macro, cambia "proveedores" por el nombre de tu hoja, el id de proveedore deberá estar en la columna A. Cambia "Tabla1" por el nombre de tu tabla.
Sub Enviar_Correos_a_Proveedores()
'Por Dante Amor
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set h1 = Sheets("Resumen")
Set h2 = Sheets("proveedores") 'hoja con los id de proveedores
'
h1.Select
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("E3").Value = h2.Cells(i, "A")
h1.ListObjects("Tabla1").Range.AutoFilter Field:=15, Criteria1:=h1.Range("E3").Value
u = h1.Range("O" & Rows.Count).End(xlUp).Row
h1.Range("A6:O" & u).Select
ActiveSheet.Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Item.to = h1.Range("E5").Value
.Item.cc = "[email protected]" 'con copia a...
.Item.bcc = "[email protected]" 'con copia oculta a...
.Item.Subject = h1.Range("A6").Value
.Introduction = ""
.Item.send
End With
Next
MsgBox "Correos enviados"
End Sub[sal u dos. no olvides valorar la respuesta.
Hola Dante, como siempre muchas gracias!
Al probarla me da error la línea de la "TABLA1" he cambiado el nombre del excel a Tabla1, he probado poniendo la extensión también "Tabla1.xlsx"
Lo que me preguntabas de la A12 en adelante, es un copiar pegar que yo hago de otro excel, pero no esta vinculada ni nada, ¿creo qué por eso me da error porque busca una tabla vinculada?
Gracias!
Según tu imagen tienes una tabla en excel. En mi ejej
Selecciona del cuadro de nombres, ahí debe aparecer el nombre de tu tabla:
Pon una imagen de tu hoja para ver cómo se llama tu tabla
También pon una imagen de tu hoja "proveedores"
Hola Dante,
Como siempre, tienes toda la razón!!
Finalmente he cambiado el nombre de Tabla que salia como "Table1" y ya funciona!!!
Muchas Gracias!
Hola Dante, con las pruebas que hice si funciona, pero supongo que es un ejemplo muy simple.
Después de probar bien he visto algunas cosas que no se si se pueden mejorar.
1 - Pasa por todos los proveedores de la pestaña proveedores, y envía algunos que no coinciden con los números de proveedor de la columna O. Es posible que haga un BUSCARV solo con los de la "Table1", ¿seria más rápido?
2 - y la más importante, al filtrar y enviar a un proveedor la información y enviarlo como una tabla, desde el email recibido puedes copiar la info ponerla en un excel y ver todas las filas ocultas, ¿esto se puede cambiar? Ya que sino estoy dando información a otros proveedores de pedidos de otros cosa que no quiero.
Te pongo las imágenes que me has pedido por si se puede mejorar, de nuevo muchas gracias por la ayuda!
Con gusto reviso las nuevas peticiones, valora esta respuesta y crea una nueva pregunta con el mayor deralle posible de lo que necesitas.
