Te anexo la macro
Private Sub But_Grabar_Click()
Call GuardarInformacion
Unload Me
End Sub
'
Sub GuardarInformacion()
Rem declaracion de variables
Dim contfila As Long
Dim hoja As Worksheet
Set hoja = Worksheets("REGISTROS")
'Call EnviarCorreo(hoja, 5)
Rem validamos que los campos de texto correspondientes a los datos esten todos ingresados
If Trim$(central.Text) = Empty Or Trim$(TextBox2.Text) = Empty Or _
Trim$(prioridad.Text) = Empty Or Trim$(Boton9.Text) = Empty Or _
Trim$(Boton10.Text) = Empty Or Trim$(Boton11.Text) = Empty Or _
Trim$(Boton12.Text) = Empty Or Trim$(Boton13.Text) = Empty Or _
Trim$(Cobre.Text) = Empty Or Trim$(ComboBox1.Text) = Empty Or _
Trim$(TextBox1.Text) = Empty Or Trim$(ComboBox2.Text) = Empty Or _
Trim$(Boton16.Text) = Empty Or Trim$(Boton29.Text) = Empty Or _
Trim$(Posta.Text) = Empty Or Trim$(ComboBox3.Text) = Empty Or _
Trim$(TextBox3.Text) = Empty Then
MsgBox "Por favor ingrese todos los datos!", vbCritical, "Datos Incompletos"
Exit Sub
End If
Rem validamos la fila siguiente en la hoja donde se deben ingresar los datos
contfila = hoja.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row
hoja.Cells(contfila, 5).Value = Me.TextBox2.Value
hoja.Cells(contfila, 6).Value = Me.central.Value
hoja.Cells(contfila, 7).Value = Me.Cobre.Value
hoja.Cells(contfila, 8).Value = Me.ComboBox1.Value
hoja.Cells(contfila, 9).Value = Me.TextBox1.Value
hoja.Cells(contfila, 10).Value = Me.ComboBox2.Value
hoja.Cells(contfila, 11).Value = Me.Boton29.Value
hoja.Cells(contfila, 12).Value = Me.Boton9.Value
hoja.Cells(contfila, 13).Value = Me.Boton10.Value
hoja.Cells(contfila, 14).Value = Me.Boton11.Value
hoja.Cells(contfila, 15).Value = Me.Boton12.Value
hoja.Cells(contfila, 16).Value = Me.Boton13.Value
hoja.Cells(contfila, 17).Value = Me.prioridad.Value
hoja.Cells(contfila, 18).Value = Me.vandalismo.Value
hoja.Cells(contfila, 19).Value = Me.Posta.Value
hoja.Cells(contfila, 20).Value = Me.ComboBox3.Value
hoja.Cells(contfila, 21).Value = Me.Boton16.Value
Call EnviarCorreo(hoja, contfila)
Rem se limpia y borra todo y el cursor queda en Boton1
Me.prioridad.Value = ""
Me.central.Value = ""
Me.Posta.Value = ""
Me.Tramite.Value = ""
Me.vandalismo.Value = ""
Me.Cobre.Value = ""
Me.Boton9.Value = ""
Me.Boton10.Value = ""
Me.Boton11.Value = ""
Me.Boton12.Value = ""
Me.Boton13.Value = ""
Me.Boton16.Value = ""
Me.Boton29.Value = ""
End Sub
'
Sub EnviarCorreo(hoja, fila)
'Por.Dante Amor
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = TextBox3
dam.Subject = "Su solicitud fue ingresada"
'
cuerpo = "Correo automático"
Set r = hoja.Range("A" & fila & ":U" & fila)
f = r.Rows.Count
c = r.Columns.Count
tabla = "<table border><tr>"
For i = 1 To r.Rows.Count
For j = 1 To r.Columns.Count
tabla = tabla & "<td>" & hoja.Cells(4, j) & "</td>"
Next
tabla = tabla & "</tr>"
For j = 1 To r.Columns.Count
tabla = tabla & "<td>" & r.Cells(i, j) & "</td>"
Next
tabla = tabla & "</tr>"
Next
tabla = tabla & "</table>"
dam.HTMLBody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & cuerpo & tabla & "</P>" & _
"</BODY> " & _
"</HTML>"
'dam. Send 'El correo se envía en automático
dam. Display 'El correo se muestra
End Sub
'S aludos. Dante Amor.