Suppression de 2 caractères dans une liste

bonjour

Je voudrais supprimer les 2 caractères de droite pour toutes les cellules qui ont un nombre de caractère supérieure a 56

ma macro plante

pourriez vous me donner un coup de main et me dire ou j'ai commis une erreur

merci

Bonjour,

A tester

Option Explicit
Public Sub Suppression_2_carct()
Dim Ws As Worksheet
Dim Derlig As Long, i As Long

    Application.ScreenUpdating = False
    Set Ws = Worksheets("Feuil1")

    With Ws
        Derlig = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To Derlig
            If Len(.Cells(i, 1)) > 54 Then .Cells(i, 1) = Left(.Cells(i, 1), 54)
        Next i
    End With

    Set Ws = Nothing

End Sub

merci

cela marche très bien