Ajuste o nome da planilha TESTE para a sua  !!

Sub DividirTexto()

Dim celulaOriginal As Range
Dim texto As String
Dim textoParte As String
Dim i As Long
Dim linhaInicio As Long
Dim totalPartes As Long

' Defina a célula que contém o texto a ser dividido
Set celulaOriginal = ThisWorkbook.Sheets("TESTE").Range("A1") 'Altere "Plan1" e "A1" conforme necessário

texto = celulaOriginal.Value
totalPartes = WorksheetFunction.Ceiling(Len(texto) / 141, 1)
linhaInicio = celulaOriginal.Row + 1

' Limpe as células abaixo da original
celulaOriginal.Offset(1, 0).Resize(totalPartes, 1).Clear

For i = 1 To totalPartes
If i * 141 > Len(texto) Then
textoParte = Mid(texto, (i - 1) * 141 + 1)
Else
textoParte = Mid(texto, (i - 1) * 141 + 1, 141)
End If
celulaOriginal.Offset(i, 0).Value = textoParte
Next i

End Sub