Macro to skip blank cells and finishes (Button to send emails)

[Karla Bermeo]

Hello everyone!
I have a problem with a macro that I'm using to send emails automatically with a button ... I'm not an expert, so I am looking for your help ? (this drives me crazy ... and btw I speak spanish)

The macro is the following:

Sub Enviar_Correo2()
'
' Enviar_Correo2
' Enviar por correo electrónico automáticamente el resumen ejecutivo del trabajo de los Equipos de Mejora Continua

'Seleccionamos el rango de celdas a enviar Select
ThisWorkbook.Sheets("Resumen ejecutivo").Range("$A$1:$K$52").Select

For I = 1 To 10

'El valor de i se pone en la celda F18 para que con BUSCARV se devuelvan
'los datos correspondientes al ID.
ThisWorkbook.Sheets("Configuraciones iniciales").Range("F18").Value = I

'Mostramos la sección para enviar correo.
ActiveWorkbook.EnvelopeVisible = True

'Llamamos al envío...
With ActiveSheet.MailEnvelope
.Item.To = ThisWorkbook.Sheets("Configuraciones iniciales").Range("$B$19").Value
'.Item.cc = "correo1@dominio.com" 'con copia a...
'.Item.bcc = "correo2@dominio.com" 'con copia oculta a...
.Item.Subject = "PROPUESTA DE TEMAS PARA APROBACIÓN GERENCIAL"
.Introduction = "Estimados Srs.: Por medio de la presente nos permitimos plantear a Ustedes los siguientes tres temas seleccionados por nuestro Equipo de Mejora Continua, con la finalidad que nos asignen uno para iniciar su estudio. Estamos seguros que el trabajo a realizar sera un aporte valioso para nuestra empresa."
.Item.Send
End With
Next I
End Sub


>> In this macro, I want to send a range of cells from a sheet "Resumen ejecutivo" to maximum 10 emails localized in another sheet called "Configuraciones iniciales" . The problem is when the user not fill all the column, that is numbered from 1 to 10. I mean not fill the table with 10 emails. If this does not happen, in the last email, the macro is repeated as many times, until 10 emails are completed or as if it were to be sent to 10 emails. I hope you can understand me.

So I want to put a statement in somewhere of this macro to skip blank cells without email addresses in the column numbered from 1 to 10 and finish the action of sending emails.

Thank you so much!

 

[Yongle]

welcome to the forum

try something like this

Sub Enviar_Correo2()
'
' Enviar_Correo2
' Enviar por correo electrónico automáticamente el resumen ejecutivo del trabajo de los Equipos de Mejora Continua

'Seleccionamos el rango de celdas a enviar Select
ThisWorkbook.Sheets("Resumen ejecutivo").Range("$A$1:$K$52").Select

For i = 1 To 10
    If ThisWorkbook.Sheets("Configuraciones iniciales").Cells(23 + i, "D") <> "" Then
'El valor de i se pone en la celda F18 para que con BUSCARV se devuelvan
'los datos correspondientes al ID.
        ThisWorkbook.Sheets("Configuraciones iniciales").Range("F18").Value = i

'Mostramos la sección para enviar correo.
        ActiveWorkbook.EnvelopeVisible = True

'Llamamos al envío...
        With ActiveSheet.MailEnvelope
        .Item.To = ThisWorkbook.Sheets("Configuraciones iniciales").Range("$B$19").Value
'.Item.cc = "correo1@dominio.com" 'con copia a...
'.Item.bcc = "correo2@dominio.com" 'con copia oculta a...
            .Item.Subject = "PROPUESTA DE TEMAS PARA APROBACIÓN GERENCIAL"
            .Introduction = "Estimados Srs.: Por medio de la presente nos permitimos plantear a Ustedes los siguientes tres temas seleccionados por nuestro Equipo de Mejora Continua, con la finalidad que nos asignen uno para iniciar su estudio. Estamos seguros que el trabajo a realizar sera un aporte valioso para nuestra empresa."
            .Item.Send
        End With
    End If
Next i
End Sub

 

[Karla Bermeo]

welcome to the forum

try something like this

Sub Enviar_Correo2()
'
' Enviar_Correo2
' Enviar por correo electrónico automáticamente el resumen ejecutivo del trabajo de los Equipos de Mejora Continua

'Seleccionamos el rango de celdas a enviar Select
ThisWorkbook.Sheets("Resumen ejecutivo").Range("$A$1:$K$52").Select

For i = 1 To 10
    If ThisWorkbook.Sheets("Configuraciones iniciales").Cells(23 + i, "D") <> "" Then
'El valor de i se pone en la celda F18 para que con BUSCARV se devuelvan
'los datos correspondientes al ID.
        ThisWorkbook.Sheets("Configuraciones iniciales").Range("F18").Value = i

'Mostramos la sección para enviar correo.
        ActiveWorkbook.EnvelopeVisible = True

'Llamamos al envío...
        With ActiveSheet.MailEnvelope
        .Item.To = ThisWorkbook.Sheets("Configuraciones iniciales").Range("$B$19").Value
'.Item.cc = "correo1@dominio.com" 'con copia a...
'.Item.bcc = "correo2@dominio.com" 'con copia oculta a...
            .Item.Subject = "PROPUESTA DE TEMAS PARA APROBACIÓN GERENCIAL"
            .Introduction = "Estimados Srs.: Por medio de la presente nos permitimos plantear a Ustedes los siguientes tres temas seleccionados por nuestro Equipo de Mejora Continua, con la finalidad que nos asignen uno para iniciar su estudio. Estamos seguros que el trabajo a realizar sera un aporte valioso para nuestra empresa."
            .Item.Send
        End With
    End If
Next i
End Sub

Thank you so much, I put this statement and it worked! So much love for you ?