Microsoft 365 Limitation caractères macro

.Range("D" & lig).Value = Left(.Range("D" & lig).Value, WorksheetFunction.Min(125, Len(.Range("D" & lig).Value) - 2))

Option Explicit

Sub Transfert()
    Dim i As Long, tb, j As Integer, k As Integer, lig As Long 'déclaration des variables
    With Sheets("DATA_MODELES") 'avec la feuille ...  tous les range qui suivent et qui ont un point devant vont sur cette feuille
        .Cells.Clear
        Cells.Interior.Pattern = xlNone
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row 'boucle sur les lignes existantes
            lig = .Range("A" & Rows.Count).End(xlUp).Row + 1 'dernière ligne +1
            If i Mod 2 = 0 Then
                .Range("A" & lig).Interior.Color = RGB(198, 224, 180)
            Else
                .Range("A" & lig).Interior.Color = RGB(217, 225, 242)
            End If
            .Range("A" & lig).Value = Range("A" & i).Value
            .Range("B" & lig).Value = "[NCL]" & Range("B" & i).Value & " " & Range("D" & i).Value
            .Range("C" & lig).Value = Range("C" & i).Value
            .Range("E" & lig).Value = Range("E" & i).Value
            lig = lig + 1
            tb = Split(Range("D" & i).Value, ",") 'tableau des modèles de la ligne
            For j = 0 To UBound(tb) 'boucle sur les modèles
                If i Mod 2 = 0 Then
                    .Range("A" & lig).Interior.Color = RGB(198, 224, 180)
                Else
                    .Range("A" & lig).Interior.Color = RGB(217, 225, 242)
                End If
                .Range("A" & lig).Value = Range("A" & i).Value & "-" & j + 1
                .Range("B" & lig).Value = Range("B" & i).Value & " " & tb(j)
                .Range("C" & lig).Value = Range("C" & i).Value
                For k = 0 To UBound(tb)
                    .Range("D" & lig).Value = .Range("D" & lig).Value & " Modèle compatible: " & tb(k) & ", "
                Next k
                .Range("D" & lig).Value = Left(.Range("D" & lig).Value, WorksheetFunction.Min(125, Len(.Range("D" & lig).Value) - 2))
                .Range("E" & lig).Value = Range("E" & i).Value
                lig = lig + 1
            Next j
        Next i
    End With
    MsgBox ("Transfert effectué")
End Sub