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

Respuesta
2

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas