Extraire caractères VBA

Sub extraction()
'dernière ligne remplie en col A
ligne = Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
'boucle sur les lignes
For n = 1 To ligne
'si la valeur en col B se retrouve en col A (lorsque NB.SI(A:A;"*" & B1 & "*") = 1)
  If WorksheetFunction.CountIf(Range("A:A"), "*" & Range("B" & n) & "*") = 1 Then
  
  'dernière colonne remplie de la ligne en question
    Col = Rows(n).Find("*", , , , xlByRows, xlPrevious).Column
    'boucle sur les colonnes de la 5eme à la dernière remplie
        For g = 5 To Col
        ' chaine inscrite dans la cellule
        cel = Cells(n, g).Value
       
            'Boucle sur les caractères de la chaine depuis le 2nd jusqu'au dernier
         For t = 1 To Len(cel)
         'si le caractère est ( on recherche la position du  ) qui suit
         If Mid(cel, t, 1) = "(" Then
          np = InStr(t, cel, ")")
         
          'on extrait alors le nombre avec ses parenthèses
          nombre = Mid(cel, t, np - t + 1)
         
          's'il n'existe qu'en un seul exemplaire dans la plage E:K  (A ADAPTER) alors on supprime le ( et on remplace le ) par une , et on ajoute à la chaine extraite
           If WorksheetFunction.CountIf(Range("E1" & ": K" & ligne), "*" & nombre & "*") = 1 Then
            aj = WorksheetFunction.Substitute(WorksheetFunction.Substitute(nombre, "(", ""), ")", ",")
             ext = ext & aj
             End If
             
        End If
         Next t
        Next g
        'on inscrit en col D la chaine extraite moins son denier caractère (la dernière ,)
        Range("D" & n) = Left(ext, Len(ext) - 1)
        ' la chaine extraite est remise à vide pour la prochaine ligne
        ext = ""
    End If
Next
End Sub