XL 2013 EClater une cellule en plusieurs lignes sur plusieurs colonnes

Private Sub CommandButton1_Click()
Dim c As Range, s, t$, i%
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
Rows("3:" & Rows.Count).WrapText = False 'pas de renvoi à la ligne
For Each c In [A2:B2,D2:G2] 'plage à adapter
  s = Split(Replace(Replace(c, vbLf, " "), " %", "%"))
  If c <> "" Then c(2).Resize(UBound(s) + 1) = Application.Transpose(s)
Next c
Set c = [C2] 'cellule à adapter
If c <> "" Then
  t = c
  For i = 0 To 9
    t = Replace(t, i & " ", i & vbLf) 'renvoi à la ligne à la place de l'espace
  Next
  c = t 'nouveau texte en C2
  s = Split(t, vbLf)
  c(2).Resize(UBound(s) + 1) = Application.Transpose(s)
End If
Columns("C").AutoFit 'ajustement largeur
Rows(2).AutoFit 'ajustement hauteur
End Sub