Je me tourne vers vous car j'aimerai copier un tableau dans le corps d'un email sans avoir à faire de sélection manuelle.
Dans la première macro (je n'ai pas encore mixé les deux) :
- on vide le tableau
- on parcours les feuilles
- on récupère les info
- on fait le récap sur le tableau
dans la 2nd partie
- je lance l'instance outlook
- je créé l'email
- je sélectionne le tableau de la première macro
- je copie le tableau
- je colle le tableau c'est là l'erreur - j'envois l'email
Je ne serais pas contre un peu d'aide sur la copie du tableau
Merci à vous,
Le code créé en partie grâce à vous :
Sub emailStud()
Application.ScreenUpdating = False
With Sheets("MStudio").ListObjects("studio") 'je vide le tableau
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete 'je vide le tableau
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" ' le destinataire
.Subject = "Récap projet" & " " & Date ' l'objet du mail
.Body = "Bonjour ," & Chr$(13) & Chr$(13) & "Voici le récap des projets en cours :" & Chr$(13) & Selection.Paste
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.Send
End With
Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub
