Como ejecutar macro especifica en ActiveSheet en cada hoja del archivo de excel.
Mi duda es como puedo ejecutar la misma macro en cada una de las páginas del libro ahora mismo tengo este código pero al ser una macro con ActiveSheet siempre detecta la misma página 1...
Sub WorksheetLoop2()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
Dim attBook$
attBook = Environ("temp") & "\" & ActiveSheet.[b1] & ".xlsx"
' Guardo la hoja activa como un libro independiente
ActiveSheet.Copy
If Dir(attBook) <> "" Then Kill attBook
With ActiveWorkbook
.SaveAs Filename:=attBook, FileFormat:=51
.Close False
End With
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ActiveSheet.[a1]
.CC = ""
.BCC = ""
.Subject = ""
.Body = ""
.Attachments.Add attBook
.display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
' Insert your code here.
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub
Quiero que se ejecute la macro en cada una de las páginas,.
Esta macro la ocupo para que envié un mail de cada hoja Activa tomando el mail de la celda A1de cada página
1 Respuesta
Te anexo la macro con las actualizaciones
Sub WorksheetLoop2()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
Dim attBook$
attBook = Environ("temp") & "\" & Current.[b1] & ".xlsx"
' Guardo la hoja activa como un libro independiente
Current.Copy
If Dir(attBook) <> "" Then Kill attBook
With ActiveWorkbook
.SaveAs Filename:=attBook, FileFormat:=51
.Close False
End With
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Current.[a1]
.CC = ""
.BCC = ""
.Subject = ""
.Body = ""
.Attachments.Add attBook
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
' Insert your code here.
' This line displays the worksheet name in a message box.
Next
MsgBox "Correos generados"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
¡Gracias!
Agradezco tu pronta y excelente respuesta..
Buen día Dante,
una consulta más, estoy intentando que el archivo se genere y Se envíe sin presionar el botón send en outlook me podías orientar un poco en ello.
gracias.
Buen día Dante ahora mismo he modificado el código para que se envíe el mail sin precio se enviar en outlook pero no logró que funcione me puedes orientar un poco
Sub WorksheetLoop2()
Dim Current As Worksheet
For Each Current In Worksheets
Dim attBook$
attBook = Environ("temp") & "\" & Current.[A4] & ".xlsx"
Current.Copy
If Dir(attBook) <> "" Then Kill attBook
With ActiveWorkbook
.SaveAs Filename:=attBook, FileFormat:=51
.Close False
End With
With ActiveWorkbook.MailEnvelope
.Item.To = Current.[a1]
.Item.Subject
.Item.CC = Current.[a2]
.Item.BCC = ""
.Item.Subject = Current.[a3]
.Item.Body = "Buen dia, se adjunta Reporete de ventas 2016"
.Attachments.Add attBook
End With
Next
MsgBox "Informes de ventas 2016 generados"
End Sub
En la macro que te envié, cambia esta línea
. Display
Por esta:
.Send
Gracias.
¿Una ultima duda si la hoja que envió se genera basado en una tabla dinámica y al enviarla no quiero que se envíe dicha tabla dinámica se puede enviar solo los datos de la hoja sin las tablas dinámica?
Intente con un par de código para borrar las tablas dinámicas pero no me funciona.
Con mucho gusto te ayudo con todas tus peticiones.
Crea una nueva pregunta en Todoexpertos.com, dentro el tema de microsoft excel. En el desarrollo de la pregunta escribe: "para Dante Amor". Ahí me describes con detalle lo que necesitas.
Sal u dos
