partager un texte dans des cellules

Sub PartageTexte()
Dim source$, dest1 As Range, dest2 As Range, h#, s, i%, x%
'---données---
source = Application.Trim(Feuil1.[A1].Text)
If source = "" Then Exit Sub
Set dest1 = Feuil2.[X15:AG15]
Set dest2 = Feuil2.[A16]
'---préparation---
dest1.UnMerge 'défusion
dest1.HorizontalAlignment = xlCenterAcrossSelection
dest1.WrapText = True 'retour à la ligne
dest1.Rows.AutoFit 'ajustement automatique
h = dest1.RowHeight 'hauteur de ligne initiale
s = Split(source) 'matrice des mots
'---remplissage de dest1---
For i = 1 To UBound(s)
  x = Len(s(0)) 'mémorisation
  s(0) = s(0) & " " & s(i)
  dest1(1) = s(0)
  dest1.Rows.AutoFit
  If dest1.RowHeight > h Then Exit For
Next
If i > UBound(s) Then x = Len(source)
dest1(1) = Left(source, x)
dest1.RowHeight = h
dest1.Merge 'refusion
dest1.HorizontalAlignment = xlGeneral
'---remplissage de dest2---
dest2 = Mid(source, x + 2)
End Sub

Sub PartageTexte1()
Dim source$, dest1 As Range, dest2 As Range, h#, s, i%, x%
'---données---
source = Application.Trim(Feuil1.[A1].Text)
If source = "" Then Exit Sub
Set dest1 = Feuil2.[X15:AG15]
Set dest2 = Feuil2.[A16]
'---préparation de dest1---
Application.ScreenUpdating = False
dest1.UnMerge 'défusion
dest1.HorizontalAlignment = xlCenterAcrossSelection
dest1.WrapText = True 'retour à la ligne
dest1.Rows.AutoFit 'ajustement automatique
h = dest1.RowHeight 'hauteur de ligne initiale
s = Split(source) 'matrice des mots
'---remplissage de dest1---
For i = 1 To UBound(s)
  x = Len(s(0)) 'mémorisation
  s(0) = s(0) & " " & s(i)
  dest1(1) = s(0)
  dest1.Rows.AutoFit
  If dest1.RowHeight > h Then Exit For
Next
If i > UBound(s) Then x = Len(source)
dest1(1) = Left(source, x)
dest1.RowHeight = h
dest1.Merge 'refusion
dest1.HorizontalAlignment = xlGeneral
'---préparation de dest2---
dest2 = ""
dest2.UnMerge 'défusion
dest2.WrapText = True
dest2.Rows.AutoFit
h = dest2.RowHeight
'---remplissage et ajustement de dest2---
dest2 = Mid(source, x + 2)
i = 1
While dest2.RowHeight > h
  i = i + 1
  Set dest2 = dest2.Resize(, i)
  dest2(, i).UnMerge 'au cas où...
  dest2(, i) = ""
  dest2.HorizontalAlignment = xlCenterAcrossSelection
  dest2.Rows.AutoFit
Wend
dest2.Merge 'refusion
dest2.HorizontalAlignment = xlGeneral
End Sub