MACRO envíe correo de una hoja con fórmulas
Tengo una hoja llamada "ANOMALIAS" que tiene referencia de otras hojas
Lo que necesito es enviar un rango especifico de la hoja ANOMALÍAS y que me salgan
Unicamente los datos en valores,
Tengo el sig código:
Sub CorreoUnaHoja2()
'por.Dante Amor
'Enviar una hoja por correo
ActiveSheet.Unprotect
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
wpath = ThisWorkbook.Path & "\"
nombre = ActiveSheet.Name
'CEL = Range("BQ3").Value
Worksheets(Hoja4.Name).Copy
ActiveWorkbook.SaveAs Filename:=wpath & nombre & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
'
Set dam = CreateObject("outlook.application").createitem(0) '
dam.to = "[email protected]" 'Destinatarios
dam.Subject = "ANOMALIAS DE VENTAS" '& "CORRESPONDIENTE AL MES DE: " & CEL '"Asunto"
dam.Body = "Confirmar de recibido" '"Cuerpo del mensaje"
dam.Attachments.Add wpath & nombre & ".xlsx"
dam.Send
Range("bp1").Select
Selection.ClearContents
'Application.CutCopyMode = False
ActiveSheet.Protect
MsgBox "Correo enviado y guardado", , "REPORTE ANOMALIAS"
End Sub
El cual me funciona pero...
Me envía todo el libro, además no se actualiza los datos de la hoja y por ultimo me sale
#REF en celdas donde hay fórmulas...
Espero me ayuden! :C
1 Respuesta
Te anexo la macro actualizada
Cambia "A1:D5", por el rango que quieras enviar.
Sub CorreoUnaHoja2()
'por.Dante Amor
'Enviar una hoja por correo
ActiveSheet.Unprotect
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
Set l1 = ThisWorkbook
Set h1 = Sheets("ANOMALÍAS")
ruta = l1.Path & "\"
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
h1.Range("A1:D5").Copy
h2.[A1].PasteSpecial Paste:=xlValues
l2.SaveAs Filename:=ruta & h1.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
l2.Close
'
Set dam = CreateObject("outlook.application").createitem(0) '
dam.To = "[email protected]" 'Destinatarios
dam.Subject = "ANOMALIAS DE VENTAS" '& "CORRESPONDIENTE AL MES DE: " & CEL '"Asunto"
dam.Body = "Confirmar de recibido" '"Cuerpo del mensaje"
dam.Attachments.Add ruta & h1.Name & ".xlsx"
dam.Send
ActiveSheet.Protect
MsgBox "Correo enviado y guardado", , "REPORTE ANOMALIAS"
End Sub
MI estimado esto donde lo pongo?
'CEL = Range("BQ3").Value
supongo que me afectara en
dam.Subject = "ANOMALIAS DE VENTAS" '& "CORRESPONDIENTE AL MES DE: " & CEL '"Asunto"
Quedaría así:
Sub CorreoUnaHoja2()
'por.Dante Amor
'Enviar una hoja por correo
ActiveSheet.Unprotect
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
Set l1 = ThisWorkbook
Set h1 = Sheets("ANOMALÍAS")
CEL = h1.[BQ3]
ruta = l1.Path & "\"
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
h1.Range("A1:D5").Copy
h2.[A1].PasteSpecial Paste:=xlValues
l2.SaveAs Filename:=ruta & h1.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
l2.Close
'
Set dam = CreateObject("outlook.application").createitem(0) '
dam.To = "[email protected]" 'Destinatarios
dam.Subject = "ANOMALIAS DE VENTAS, CORRESPONDIENTE AL MES DE: " & CEL '"Asunto"
dam.Body = "Confirmar de recibido" '"Cuerpo del mensaje"
dam.Attachments.Add ruta & h1.Name & ".xlsx"
dam.Send
ActiveSheet.Protect
MsgBox "Correo enviado y guardado", , "REPORTE ANOMALIAS"
End Sub
