Sub Essai()
  Dim Trouvé As String, ListeTrouvés As String
  Dim Prefixes As Variant, Prefixe As Variant
  Dim Total As Long

  'Pour la sortie dans un fichier Word
  Dim Fichier As Document
  Dim Plage As Range
  Dim TableauListe As Table

  'Construction de la liste
  Prefixes = Array("PE-", "JEB-", "HEL-")

  For Each Prefixe In Prefixes
    With ActiveDocument.Content.Find

      .ClearFormatting
      .MatchWildcards = True
      .Text = Prefixe & "[0-9]{1,}"
      .Forward = True

      Do While .Execute
        Trouvé = .Parent.Text
        If InStr(1, ListeTrouvés, Trouvé & " ") = 0 Then
          ListeTrouvés = ListeTrouvés & Trouvé & " "
          Total = Total + 1
        End If
      Loop

    End With
  Next Prefixe

  ListeTrouvés = Trim(ListeTrouvés)
  ListeTrouvés = Replace(ListeTrouvés, " ", vbCrLf)
  
  'Sauvegarde de la liste dans un fichier Word
  Set Fichier = Documents.Add()
  Set Plage = Fichier.Range
  Plage.Text = "Liste à sauvegarder :" & vbCrLf
  
   'Impression de la liste ordonnée
  Plage.Collapse Direction:=wdCollapseEnd
  Plage.Text = ListeTrouvés
  Set TableauListe = Plage.ConvertToTable(Separator:="-")
  TableauListe.Sort FieldNumber:="Colonne 1", SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
    FieldNumber2:="Colonne 2", SortFieldType2:=wdSortFieldNumeric, SortOrder2:=wdSortOrderAscending
  TableauListe.Rows.ConvertToText Separator:="-"
  
  'Impression du total
  Plage.Collapse Direction:=wdCollapseEnd
  Plage.Text = "Total = " & CStr(Total)

End Sub