Copy/paste Excel table to Outlook

Bonjour,

I am reaching out to you because I would like to copy a table into the body of an email without having to make a manual selection.

In the first macro (I haven't mixed the two yet):
- we clear the table
- we loop through the sheets
- we retrieve the information
- we summarize it in the table

In the second part
- I launch the Outlook instance
- I create the email
- I select the table from the first macro
- I copy the table
- I paste the table this is where the error is
- I send the email

I wouldn't be against a bit of help on copying the table

Thank you,

The code created partly thanks to you:

 Sub emailStud() Application.ScreenUpdating = False With Sheets("MStudio").ListObjects("studio") 'we clear the table If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete 'we clear the table 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 'page name + link Range("B" & LastR).Value = Sheets(i).Range("C2").Value 'operation title Range("C" & LastR).Value = Sheets(i).Range("F43").Value Range("D" & LastR).Value = Sheets(i).Range("F44").Value Else End If Next 'Next Sheet 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 ------------------------------------------------------------------------------------------------------- 'You need to activate the "Microsoft Outlook Library" reference Before running this macro, ' In the VBA editor: Go to Menu / Tools / References / Check "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" ' the recipient .Subject = "Project Summary" & " " & Date ' the subject of the mail .Body = "Hello," & Chr$(13) & Chr$(13) & "Here is the summary of ongoing projects:" & Chr$(13) & Selection.Paste .Display ' Here we can remove it to send without verification .Send End With Set oBjMail = Nothing Set ObjOutlook = Nothing End Sub 

Configuration: Windows 7 / Chrome 39.0.2171.99