Quelle fonction?

       Private Sub Workbook_Open()
       End Sub

 Dim i As Integer
Dim j As Integer
Dim y As String
Dim listedestinataires() As String
Dim trouvedestinataires() As String
Dim nbdest As Integer
Dim VarTab As Variant


nbdest = 1
j = 1
'initialiser ici la lettre de la colonne qui contient l'entête destinataire
y = "A"
i = 1

Do While Feuil1.Cells(i, y).Value <> ""
    trouvedestinataires = Filter(listedestinataires, "Destinataire " & (Feuil1.Cells(i, y).Value), True)
    On Error Resume Next
    VarTab = UBound(trouvedestinataires)
    On Error GoTo 0
    
    
    If VarTab < 0 Or i = 1 Then
        Sheets.Add.Move After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "Destinataire " & (Feuil1.Cells(i, y).Value)
        nbdest = nbdest + 1
        ReDim Preserve listedestinataires(nbdest)
        listedestinataires(nbdest) = "Destinataire " & (Feuil1.Cells(i, y).Value)
        ActiveSheet.Cells("1", "A").Select
    Else
        Sheets("Destinataire " & (Feuil1.Cells(i, y).Value)).Activate
        j = 1
        Do While Sheets("Destinataire " & (Feuil1.Cells(i, y).Value)).Cells(j, y).Value <> ""
            j = j + 1
        Loop
        Sheets("Destinataire " & (Feuil1.Cells(i, y).Value)).Cells(j, "A").Select
    End If

    Feuil1.Cells(i, y).EntireRow.Copy
    Sheets("Destinataire " & (Feuil1.Cells(i, y).Value)).Paste

    i = i + 1
Loop


'on parcours les lignes
'   si c 'est la première fois qu'on voit le code destinataire
'         on crée une nouvelle feuille
'         on se place dessus à la première ligne
'   si le code destinataire a déjà été croisé
'         on se place sur la feuille correspondante
'         et sur la dernière ligne +1
'   On copie la ligne de la feuille 1 sur la feuille en cours

End Sub