Envoi en CC mail liste en colonne D sans doublons

[/contents/446-fichier-sub Sub] filtre()
Dim plg As Range
Dim strbody As String
Dim fich As Variant
Dim ShT As Worksheet

fich = Application.GetOpenFilename("Tous les fichiers (*.xlsx),*.xlsx")
If fich = False Then Exit Sub

Workbooks.Open fich
Application.ScreenUpdating = False
With Sheets(1)
Sheets.Add
Set ShT = ActiveSheet
    'définition de la plage de données initiale
    Set plg = .Range("A4:l" & .Cells(Rows.Count, 1).End(xlUp).Row)
    'copie dans une colonne provisoire le nom des mails qu'il faudra creer/filtrer
    .[C:C].Copy .[O1]
    'supprime doublons
    .[O:O].RemoveDuplicates Columns:=Array(1), Header:=xlYes
    'utilisation de deux cellules provisoires une pour l'entete de recherche
    .[P1] = .[C4]
    
    'on passe en revu toutes les participations à dispo
    For i = 4 To .[O65536].End(xlUp).Row
    ShT.[A1].CurrentRegion.Delete
        'l'autre les participants à rechercher
        .[p2] = .Range("O" & i)
         
        'filtre avancé avec copie immédiate
        plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.[P1:P2], CopyToRange:=ShT.[A1]
        ShT.Range("A:l").EntireColumn.AutoFit
        ShT.Rows(1).Insert
        ShT.[A1] = ""
        
        strbody = "<b><font color=cornflowerblue>" & "<i>Bonjour,</i><p><i><font color=cornflowerblue></i>" & "<b><font color=cornflowerblue>" & "<p>Je vous prie de trouver ci-après, le récapitulatif de votre participation à XXXX!" & "<A href=" & "file://..........." & "<p>Délégation électronique à signer svp !</A>" & "<b><font color=cornflowerblue>" & RangetoHTML(ShT.Range("A1:l" & ShT.Cells(Rows.Count, 1).End(xlUp).Row)) & "<p>Bien cordialement,"
        EnvoiAutomatiqueMail strbody, .[p2]
    Next i
End With
ActiveWorkbook.Close False
End Sub


Public Sub EnvoiAutomatiqueMail(strbody As String, adresse As String)
Dim OutlookApp As Object
Dim OutlookMail As Object

Dim adresse2 As String
Dim message As String
Dim sujet As String

Dim i As Integer
Dim delegation As String
delegation = ""

        sujet = "Récapitulatif participation à XXXX + lien vers délégation électronique"
        Set OutlookApp = CreateObject("outlook.application")
        Set OutlookMail = OutlookApp.createitem(0)
            With OutlookMail
            .Subject = sujet 'sujet du mail
            .To = adresse 'adresse mail destinataire
            <bold>.cc =  'adresse mail manager
</bold>            .HTMLBody = strbody
            .Display 'affiche le mail
            '.send 'on envoie le mail créé
            End With
End Sub


Function RangetoHTML(rng As Range)
'
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function