Sub Essai()
  Dim i As Long, Trouvé As String, ListeTrouvés As String, Prefixes As Variant, Total As Long
  ListeTrouvés = " "
  Prefixes = Array("PE-", "JEB-", "HEL-")
  For i = 0 To UBound(Prefixes)

    With ActiveDocument.Content.Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = Prefixes(i) & "[0-9]{1;}"
      .Forward = True
      .Execute

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

    End With
  Next i
  ListeTrouvés = Trim(ListeTrouvés)
  ListeTrouvés = Replace(ListeTrouvés, " ", Chr(13))
  Debug.Print ListeTrouvés
  Debug.Print "Total = " & Total
End Sub

.Text = Prefixe & "[0-9]{1;}"

{1;}

{1,}

Sub Essai()
  Dim Trouvé As String, ListeTrouvés As String
  Dim Prefixes As Variant, Prefixe As Variant
  Dim Total As Long
  
  'pour sortie dans un fichier texte
  Dim SortieFichier As Integer
  
  ListeTrouvés = " "
  Prefixes = Array("PE-", "JEB-", "HEL-")
  
  For Each Prefixe In Prefixes

    With ActiveDocument.Content.Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = Prefixe & "[0-9]{1,}"
      .Forward = True
      .Execute

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

    End With
  Next Prefixe
  
  ListeTrouvés = Trim(ListeTrouvés)
  ListeTrouvés = Replace(ListeTrouvés, " ", vbCrLf)
  ListeTrouvés = ListeTrouvés & vbCrLf & "Total = " & CStr(Total)
  
  'Sortie des résultats dans le fichier texte
  SortieFichier = FreeFile
  Open "c:\SortieFichier.txt" For Output As #SortieFichier
  Print #SortieFichier, ListeTrouvés
  Close #SortieFichier
End Sub

Sub ScratchMacro()
Dim Prefixes As Variant, Prefix As Variant
Dim oColUnique As New Collection
Dim arrUnique() As String
Dim lngIndex As Long
Dim oRng As Range
Dim strOut As String
  'What do we want to find
  Prefixes = Array("PE-", "JEB-", "HEL-")
  For Each Prefix In Prefixes
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = Prefix & "[0-9]{1,}"
      .Forward = True
      While .Execute
        On Error Resume Next
        oColUnique.Add Trim(oRng.Text), Trim(oRng.Text)
        If Err.Number = 0 Then
          'Any duplicate will error (i.e., and error number <> 0). This code runs for unique results only.
          ReDim Preserve arrUnique(lngIndex)
          arrUnique(lngIndex) = oRng.Text
          lngIndex = lngIndex + 1
        End If
        oRng.Collapse wdCollapseEnd
      Wend
    End With
  Next Prefix
  'Sort results
  WordBasic.SortArray arrUnique
  'Form a string from the results
  strOut = Join(arrUnique, vbCr) & vbCr & "Total - " & UBound(arrUnique) + 1
  'Msgbox strOut
  WriteToTextFile "D:\Collection Results.txt", strOut
lbl_Exit:
  Exit Sub
End Sub

Sub WriteToTextFile(strPath As String, strContent As String)
Dim oFSO As Object, oFile As Object
Dim lngIndex As Long
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFile = oFSO.CreateTextFile(strPath)
  oFile.Close
  lngIndex = FreeFile
  Open strPath For Output As #lngIndex
  Print #lngIndex, strContent
  Close #lngIndex
lbl_Exit:
  Set oFSO = Nothing: Set oFile = Nothing
  Exit Sub
End Sub

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

  'pour sortie dans un fichier Word
  Dim Fichier As Document

  ListeTrouvés = " "
  Prefixes = VBA.Array("PE-", "JEB-", "HEL-")

  For Each Prefixe In Prefixes

    With ActiveDocument.Content.Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = Prefixe & "[0-9]{1,}"
      .Forward = True
      .Execute

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

    End With
  Next Prefixe

  ListeTrouvés = Trim(ListeTrouvés)
  ListeTrouvés = Replace(ListeTrouvés, " ", vbCrLf)
  ListeTrouvés = ListeTrouvés & vbCrLf & "Total = " & CStr(Total)

  'Création du fichier Word de sauvegarde de la liste
  Set Fichier = Documents.Add()
  Fichier.Range.Text = "Liste à sauvegarder" & vbCrLf & ListeTrouvés
    
 End Sub

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

  'pour sortie dans un fichier Word
  Dim Fichier As Document

  ListeTrouvés = " "
  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)
  ListeTrouvés = ListeTrouvés & vbCrLf & "Total = " & CStr(Total)

  'Création du fichier Word de sauvegarde de la liste
  Set Fichier = Documents.Add()
  Fichier.Range.Text = "Liste à sauvegarder" & vbCrLf & ListeTrouvés

End Sub

Option Explicit
Sub ScratchMacro()
Dim Prefixes As Variant, Prefix As Variant
Dim oColUnique As New Collection
Dim arrUnique() As String
Dim lngIndex As Long
Dim oRng As Range
Dim strOut As String
  'What do we want to find
  Prefixes = Array("PE-", "JEB-", "HEL-")
  For Each Prefix In Prefixes
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = Prefix & "[0-9]{1,}"
      .Forward = True
      While .Execute
        On Error Resume Next
        oColUnique.Add Trim(oRng.Text), Trim(oRng.Text)
        If Err.Number = 0 Then
          'Any duplicate will error (i.e., and error number <> 0). This code runs for unique results only.
          ReDim Preserve arrUnique(lngIndex)
          arrUnique(lngIndex) = oRng.Text
          lngIndex = lngIndex + 1
        End If
        oRng.Collapse wdCollapseEnd
      Wend
    End With
  Next Prefix
  'Sort results
  WordBasic.SortArray arrUnique
  WriteToExcel arrUnique
lbl_Exit:
  Exit Sub
End Sub

Sub WriteToExcel(ByRef arrPassed As Variant)
Dim oApp As Object, oBook As Object, oSheet As Object
Dim lngNextRow As Long
  If Not IsArray(arrPassed) Then Exit Sub
  On Error Resume Next
  Set oApp = GetObject(, "Excel.Application")
  If Err <> 0 Then Set oApp = CreateObject("Excel.Application")
  On Error GoTo 0
  With oApp
      .Visible = True
      Set oBook = .Workbooks.Add
  End With
  Set oSheet = oBook.Sheets("Sheet1")
  lngNextRow = oSheet.Range("A" & oSheet.Rows.Count).End(-4162).Row + 1
  oBook.Sheets(1).Range("A" & lngNextRow).Resize(UBound(arrPassed) - LBound(arrPassed) + 1).Value = oApp.Transpose(arrPassed)
lbl_Exit:
  Set oApp = Nothing: Set oBook = Nothing: Set oSheet = Nothing
  Exit Sub
End Sub

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