Copiar/pegar tabla de Excel en Outlook

jpub Mensajes publicados 43 Fecha de registro   Estado Miembro Última intervención   -  
f894009 Mensajes publicados 17417 Fecha de registro   Estado Miembro Última intervención   -
Hola,

Me dirijo a ustedes porque me gustaría copiar una tabla en el cuerpo de un correo sin tener que hacer selección manual.

En la primera macro (todavía no he mezclado las dos) :
- se vacía la tabla
- se recorren las hojas
- se recuperan las informaciones
- se hace el recapitulativo en la tabla

en la segunda parte
- inicio la instancia de Outlook
- creo el correo
- selecciono la tabla de la primera macro
- copio la tabla
- pego la tabla ahí está el error
- envío el correo

No me importaría recibir un poco de ayuda sobre la copia de la tabla

Gracias a ustedes,

El código creado en parte gracias a ustedes:

 Sub emailStud() Application.ScreenUpdating = False With Sheets("MStudio").ListObjects("studio") 'voy a vaciar la tabla If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete 'voy a vaciar la tabla End With Dim LastR As Long Dim subAss As String Dim valCell As String Dim CyViA As String Dim Trouve As Range For i = 7 To Sheets.Count If Sheets(i).Range("G43").Value = False And Sheets(i).Range("G44").Value = False Then subAdd = Sheets(i).Name & "!j2" valCell = Sheets(i).Range("j2").Value LastR = Derniere_Ligne(ActiveSheet) + 1 ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & LastR), Address:="", SubAddress:=subAdd, TextToDisplay:=valCell 'nom de page + lien Range("B" & LastR).Value = Sheets(i).Range("C2").Value 'titre d opé Range("C" & LastR).Value = Sheets(i).Range("F43").Value Range("D" & LastR).Value = Sheets(i).Range("F44").Value Else End If Next 'Feuille Suivante Application.ScreenUpdating = True End Sub ------------------------------------------------------------------------------------------------- Function Derniere_Ligne(Sh As Worksheet) As Long Derniere_Ligne = Sh.Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row End Function ------------------------------------------------------------------------------------------------------- 'Il faut activer la référence "Microsoft Outlook Library" Avant de lancer cette macro, ' Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library" Sub Envoyer_Mail_Outlook() Dim ObjOutlook As New Outlook.Application Dim oBjMail Dim Nom_Fichier As String Sheets("MStudio").ListObjects("studio").Select Selection.Copy Set ObjOutlook = New Outlook.Applicatio Set oBjMail = ObjOutlook.CreateItem(olMailItem) With oBjMail .To = "EMAIL" ' destinatario .Subject = "Récap projet" & " " & Date ' objeto del correo .Body = "Bonjour ," & Chr$(13) & Chr$(13) & "Voici le récap des projets en cours :" & Chr$(13) & Selection.Paste .Display ' Aquí se puede eliminar para enviarlo sin verificación .Send End With Set oBjMail = Nothing Set ObjOutlook = Nothing End Sub 


Configuración: Windows 7 / Chrome 39.0.2171.99

1 respuesta