Macro Excel outlook - Envoie de mails automatiquement

J'ai trouvé un code sur internet qui envoie mon mail à tous les adresses que j'ai sur excel d'un seul coup. J'aimerais le modifier afin qu'il envoie le mail aux adresses de manière séparée. Par exemple si on a 10 adresses on aura dix mails envoyés séparément.
Je vous remercie d'avance de votre aide.

Voici le code à modifier :
Option Explicit

Sub envoi_Feuille()
Dim olapp As Outlook.Application
Dim malist, Count, Envoi, AdresseRépertoire As Variant
On Error Resume Next
'-------Contrôler dans Bisual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché
Dim adresse(1 To 10)
'----------------------Création de la liste d'adresses mail contenus de la ligne 2 à 10
Set malist = Sheets("Feuil1").Range("A2:A10")
Count = 1
For Each Envoi In malist
If Len(Envoi) Then adresse(Count) = Envoi: Count = Count + 1
Next
'----------------------Copie de la liste d'adresse dans une cellule vide exemple H1
[H1] = Array(adresse(1) & "; " & adresse(2) & "; " & _
adresse(3) & "; " & adresse(4) & "; " & adresse(5) & "; " & adresse(6), adresse(7), adresse(8), adresse(9), adresse(10))
'-------adresse du répertoire ou sera enregistré le fichier
AdresseRépertoire = ActiveWorkbook.Path
'---------------------copie de la feuille à envoyer
Application.DisplayAlerts = False
Sheets("Feuil2").Copy
'---------------------Nom du fichier à envoyer
ActiveWorkbook.SaveAs AdresseRépertoire & "\" & "Class.xls" ' ou adresse si le nom est dans une cellule Range("E2").Value & ".xls"
ActiveWindow.Close
'---------------------Envoi par mail
Sheets("Feuil1").Select
Range("H1").Select
'---------------------contrôle la validité ou la présence d'adresse mail en H1
If [H1] Like "*@*" Then
'---------------------Le mail est envoyé que si y a des adresses feuille 1 en H1
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = Range("H1").Value 'Adresse de la cellule contenant la liste des adesses mails
'--------------------Saisir le sujet de l'envoi
msg.Subject = "Candidature spontanée - Ingénieur " ' ou saisir le sujet dans une cellule ex. Range("H2").Value
'---------------------saisie du message
msg.Body = "Bonjour" & Chr(13) & Chr(13) & "Body " & Chr(13) & Chr(13) & "line" & Chr(13) & Chr(13) & "Cordialement," & Chr(13) & "bengreen"
'---------------------ou saisir le message dans des cellules
'msg.Body = Range("E5").Value & Chr(13) & Chr(13) & Range("E8").Value & Chr(13) & Chr(13)& Range("E10").Value
'---------------------ou saisir le message dans des cellules
'---------------------Adresse de la pièce jointe
msg.Attachments.Add Source:="C:\Users\bengreen\Desktop\file.pdf" ' ou adresse si le nom est dans une cellule Range("E2").Value & ".xls"
msg.Send
'---------------------effacement de la liste d'envoi
[H1].ClearContents
Loop
Else
MsgBox "Aucune adresse valide sélectionnée"
End If
Application.ScreenUpdating = True
End Sub