Envoie de mail + Corp + Pieces Jointe + ObBot par apport au tableau

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) <<<< ORIGINAL
  Sheets("NOTE").Add After:=Sheets("NOTE")(Sheets("NOTE").Count)<<<<<<FAUX
  j = 2
  With Sheets(1)

    .Rows(1).Copy Sheets("NOTE").Rows(1)
    For i = 2 To .[A65536].End(xlUp).Row
      If .Sheets("NOTE").Cells(i, 1) = "COURRIER" Then 'Or .Sheets("NOTE").Cells(i, 1) = "VERIF"' POUR 2 CRITERE
        Sheets("NOTE").Rows(i).Copy Sheets("NOTE").Rows(j)
        j = j + 1
      End If
    Next
  End With
  
  Set rng = Nothing
  On Error Resume Next
  Set rng = Sheets("NOTE").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 = "monjob@hotmail.com"
    .CC = ""
    .BCC = ""
    .Subject = "COURRIER DU " & Sheets("NOTE").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
  Sheets("NOTE").Delete

MsgBox "COURRIER ENVOYES"
  With Application
    .EnableEvents = -1
    .ScreenUpdating = -1
    .DisplayAlerts = -1
  End With
End Sub