Copie Tableau d'un Feuil et envoie par mail

  • Initiateur de la discussion Initiateur de la discussion Bens7
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Bens7

XLDnaute Impliqué
Bonjour a tous j'ai un code pour envoyer mes COURRIER en tableau Feuil2 (NOTE) avec Outlook mais ca marche qui si le bouton se trouve dans la Feuil NOTE je souhaiterais deplacer le bouton dans la Feuil1 (Administrateur )mais ca marche pas si vous pouvez m;aider je vous met le code Merci

Code:
Private Sub CommandButton3_Click() 'COURRIER OU VERIF
Dim OutApp As Object, OutMail As Object
Dim Debut$, Fin$
Dim rng As Range
Dim i&, j&
  With Application
    .EnableEvents = 0
    .ScreenUpdating = 0
  End With
  Sheets.Add After:=Sheets(Sheets.Count)
  j = 2
  With Sheets(1)
    Rows(1).Copy .Rows(1)
    For i = 2 To [A65536].End(xlUp).Row
      If Cells(i, 1) = "COURRIER" Then 'Or .Cells(i, 1) = "VERIF"' POUR 2 CRITERE
        Rows(i).Copy .Rows(j)
        j = j + 1
      End If
    Next
  End With
  
  Set rng = Nothing
  On Error Resume Next
  Set rng = Range("A1:C" & [A65536].End(xlUp).Row)
  On Error GoTo 0
  If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected" & _
      vbNewLine & "please correct and try again.", vbOKOnly
    Exit Sub
  End If
  Debut = "Bonjour , <BR>.<BR>"
  Fin = "<BR>.<BR>"
    
  Set OutApp = CreateObject("Outlook.Application")
  OutApp.Session.Logon
  Set OutMail = OutApp.CreateItem(0)
    
  On Error Resume Next
  With OutMail
    .To = "xxxxxxxxxx@romandie.com"
    .CC = "xxxxxxxxxxx@hotmail.com"
    .BCC = ""
    .Subject = "COURRIER DU " & Cells(1, 1)
        
    .HTMLBody = Debut & RangetoHTML(rng) & Fin
        
    .Display
      '.Send
  End With
  On Error GoTo 0
 
  Set OutMail = Nothing
  Set OutApp = Nothing
  Application.DisplayAlerts = 0
  ActiveSheet.Delete

MsgBox "COURRIER ENVOYES"
  With Application
    .EnableEvents = -1
    .ScreenUpdating = -1
    .DisplayAlerts = -1
  End With
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
235
Réponses
4
Affichages
177
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
2
Affichages
153
Réponses
10
Affichages
281
Retour