XL 2016 Code vba envoi mail classeur excel

Sub suite()
Pardon, le code:
Sub mail ()
If MsgBox("SOUHAITEZ-VOUS ENVOYER LE POINT CA PAR EMAIL ?" & Chr(13) & Chr(10) & "( Une nouvelle fenètre OUTLOOK va être ouverte )", 36, "Envoyer Email") = vbYes Then
  
    Dim OL As Object, myItem As Object, wDoc As Object, Rng As Object
    Dim Fichier As String, plage_mail As Range
    Set OL = CreateObject("Outlook.Application")
    Set myItem = OL.CreateItem(olMailItem)
    Set wDoc = myItem.GetInspector.WordEditor
    Set FL = Worksheets("Feuil1!")
    Set plage_mail = Worksheets("Feuil1!").Range("A1:K29")
            
    Workbooks("Monfichier.xlsm").Activate
    ActiveWorkbook.SendMail Recipients:=Range("c258954").Value
        Application.DisplayAlerts = True
 
    
  
    With myItem
        .To = ListeTo
        .Subject = "Blablabla"
        .Body = Worksheets("Base").Range("L6")
        .Attachments.Add Application.ActiveWorkbook.FullName
        .Display
        plage_mail.Copy
        Set Rng = wDoc.Content
        Rng.InsertParagraphAfter
        Rng.Move 4, 1
        Rng.Paste
        Rng.Move 4
        
            
           End With

End If
    
    Set OL = Nothing: Set myItem = Nothing: Set wDoc = Nothing
    'Remonte à la cellule de Sélection du Magasin
    Range("A1").Activate

End Sub

Function ListeTo()
    xCpt = 0
    With Sheets("Base")
        For Each xCell In .Range("C5")
            xCpt = xCpt + 1
            If xCpt = 1 Then
                xTo = xCell
            Else
                xTo = xTo & ";" & xCell
            End If
        Next xCell
    End With
    ListeTo = xTo
End Function


Private Sub CommandButton1_Click()

End Sub

Option Explicit

Const olMailItem As Integer = 0

Sub mail()
  Dim Fl As Worksheet
  Dim OL As Object, myItem As Object, wDoc As Object, Rng As Object
  Dim Fichier As String, Plage_Mail As Range

  If MsgBox("SOUHAITEZ-VOUS ENVOYER LE POINT CA PAR EMAIL ?" & vbCr _
          & "( Une nouvelle fenètre OUTLOOK va être ouverte )", vbYesNo, "Envoyer Email") = vbNo Then Exit Sub
 
  Set OL = CreateObject("Outlook.Application")
  Set myItem = OL.CreateItem(olMailItem)
  Set wDoc = myItem.GetInspector.WordEditor
  Set Fl = Worksheets("Feuil1!")
  Set Plage_Mail = Worksheets("Feuil1!").Range("A1:K29")
 
  With myItem
    .Display
    .To = ListeTo
    .Subject = "Blablabla"
    .Body = Worksheets("Base").Range("L6")
    Plage_Mail.Copy
    Set Rng = wDoc.Content
    Rng.InsertParagraphAfter
    Rng.Move 4, 1
    Rng.Paste
    Rng.Move 4
    .Attachments.Add Application.ActiveWorkbook.FullName
  End With

  Set OL = Nothing: Set myItem = Nothing: Set wDoc = Nothing
  'Remonte à la cellule de Sélection du Magasin
  Range("A1").Activate
End Sub

Function ListeTo()
  Dim xCell As Range, xCpt As Integer, xTo As String
  xCpt = 0
  With Sheets("Base")
    For Each xCell In .Range("C5")
      xCpt = xCpt + 1
      If xCpt = 1 Then
        xTo = xCell
      Else
        xTo = xTo & ";" & xCell
      End If
    Next xCell
  End With
  ListeTo = xTo
End Function