Macro pour envoi d'un onglet par mail

Sub SendEmail()
 
Dim olApp As Outlook.Application
Set olApp = CreateObject("outlook.application")
Dim LWorkbook As Workbook
Dim LFileName As String
Dim i As Integer: i = 1

   
   Do
        Dim olMail As Outlook.MailItem
        Set olMail = olApp.CreateItem(olMailItem)
        
        With olMail
           .Recipients.Add (Sheets("Bilan").Range("B" & i).Value)
           .Subject = "Fiche personnelle"
    
            Sheets(Sheets("Bilan").Range("A" & i).Value).Copy
            Set LWorkbook = ActiveWorkbook
            LFileName = LWorkbook.Worksheets(1).Name
            LWorkbook.SaveAs Filename:=LFileName
            
           .Body = "Bonjour," & vbCrLf _
           & vbCrLf _
           & "Vous trouverez ci joint votre fiche personnelle." & vbCrLf _
           & vbCrLf _
           & "Cordialement" & vbCrLf _
           & vbCrLf & vbCrLf _
           & "NOM PRENOM" ' Ton nom à mettre ici !
           
           .Attachments.Add LWorkbook.FullName
           .Display
           .Send
           
            LWorkbook.ChangeFileAccess Mode:=xlReadOnly
            Kill LWorkbook.FullName
            LWorkbook.Close SaveChanges:=False
            
        End With
        i = i + 1
    Loop While Sheets("Bilan").Range("A" & i).Value <> ""

End Sub

 With NewMail
      For i = 1 to 4
       .Recipients.Add (Sheets(i).Range("A1:F18").Value)
       
       'Sujet :
       .Subject = "sujet"
       'Copies
       .CC = "chef@test.com;adjoint@test.com"
 
       'Corps du mail :
       .Body = "Bonjour," & vbCrLf _
       & vbCrLf _
       & "Vous trouverez ci joint le  " & Sheets(i).Range("A1").Value & vbCrLf _
       & vbCrLf _
       & "Cordialement" & vbCrLf _
       & vbCrLf & vbCrLf _
       & "pseudo"
 
       .Attachments.Add ActiveWorkbook.FullName
       .Display
       'Envoi :
       .Send
     Next
 End With