Essayer les modifs suivantes :
Sub NmPnmNjf()
Dim Tf(), npf, n%, i%, j%
With ActiveSheet
n = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim Tf(1 To n, 2)
For i = 1 To n
npf = Trim(.Cells(i, 1))
If InStr(npf, "(") Then
npf = Split(Replace(npf, ")", "("), "(")
Tf(i, 2) = Trim(npf(1))
npf(1) = ""
For j = 0 To UBound(npf)
npf(j) = Trim(npf(j))
Next j
npf = Trim(Replace(Join(npf), " ", " "))
End If
npf = Split(npf)
On Error GoTo Except
For j = 0 To UBound(npf)
Select Case Asc(Mid(npf(j), Len(npf(j)), 1))
Case 65 To 90
Tf(i, 0) = Tf(i, 0) & " " & npf(j)
npf(j) = ""
End Select
Next j
Tf(i, 0) = Trim(Tf(i, 0))
npf = Trim(Join(npf))
Tf(i, 1) = npf
Rtn:
On Error GoTo 0
Next i
With .Range("B1:D" & n)
.Value = Tf
.Columns.AutoFit
End With
End With
Exit Sub
Except:
For j = 0 To 2
Tf(i, j) = Empty
Next j
ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
GoTo Rtn
End Sub
L'exécution se poursuivra mais l'assemblage provoquant erreur ne sera pas traité et la cellule en A colorée en jaune.
Cordialement.