Ma fonction tourne à l'infini

Sub test()

' Tableaux
' Range(Cells(2, 2) :
' Premiere celule du tableau pour 2,2 c'est la celule B2
' Cells(Cells(65536, 2).End(xlUp).Row, Cells(2, 256).End(xlToLeft).Column)
' ici Cells(65536, 2).End(xlUp).Row = Pour la derniére ligne "Non Vide" de la colonne B2
' Ici Cells(2, 256).End(xlToLeft).Column = Pour la derniére colonne "Non Vide" de la colonne IV2
'
Set T = Range(Cells(2, 2), Cells(Cells(65536, 2).End(xlUp).Row, Cells(2, 256).End(xlToLeft).Column))
' Nettoyage format du tableau
Range(T.Address) = Application.Trim(T.Value) ' 'Supprime tous les espaces en trop

End Sub

' Tableau
Set T = Range(Cells(1, 1), Cells(Cells(1048576, 1).End(xlUp).Row, Cells(1, 16384).End(xlToLeft).Column))
' Nettoyage format du tableau
Range(T.Address) = Application.Trim(T.Value) ' 'Supprime tous les espaces en trop

Sub TestTrim()
Dim maZone As Range, Col As Range, colVals
Dim h0 As Single, i As Long, ModeRecalcul

h0 = Timer
Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual

Set maZone = ActiveSheet.UsedRange
For Each Col In maZone.Columns
  colVals = Col.Value
  For i = 1 To UBound(colVals)
    colVals(i, 1) = xlTrim(colVals(i, 1))
  Next i
  Col = colVals
Next Col

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ActiveSheet.Columns("A:CW").EntireColumn.AutoFit
MsgBox Format(Timer - h0, "0,00""s""")
End Sub

Function xlTrim(xS) As String
Dim L
xlTrim = Trim(xS)
Do
  L = Len(xlTrim)
  xlTrim = Replace(xlTrim, "  ", " ")
Loop Until L = Len(xlTrim)
End Function