Attribute VB_Name = "Module2"
Option Explicit

Dim tablo, tabloR()
Dim i&, n&, nbrc&, nb&, nbD, k&, col$, ncol&

Private Sub Tabulations2()
  Application.ScreenUpdating = False
  Cells.VerticalAlignment = xlCenter
  For ncol = 1 To 4
    col = Choose(ncol, "Z", "AB", "AD", "AJ")
    tablo = Range(col & "2:" & col & Range(col & Rows.Count).End(xlUp).Row)
    Range(col & "2:" & col & Range(col & Rows.Count).End(xlUp).Row).VerticalAlignment = xlTop
    Range(col & "2:" & col & Range(col & Rows.Count).End(xlUp).Row).ClearContents
    k = 0
    For i = 1 To UBound(tablo, 1)
      If tablo(i, 1) <> "" Then
        nbrc = Len(tablo(i, 1))
        n = 0
        For nb = 1 To nbrc + 1
          If (Mid(tablo(i, 1), nb, 1) = "," _
              And Mid(tablo(i, 1), nb + 1, 1) <> " ") _
              Or nb = nbrc + 1 Then
            ReDim Preserve tabloR(1 To 1, 1 To k + 1)
            If Range(col & i + 1) = "" Then
              Range(col & i + 1) = Mid(tablo(i, 1), 1 + n, nb - n - 1)
            Else
              Range(col & i + 1) = Range(col & i + 1) & vbLf & Mid(tablo(i, 1), 1 + n, nb - n - 1)
            End If
            n = nb
          End If
        Next nb
        'k = k + 1
      End If
    Next i
  Next ncol
End Sub

Private Sub Codes3()
  Dim c As Range, n%, i%, col
  col = Split("F H X Y AA AC AE AF AH AI AG AK AL AM AN AO")
  Application.ScreenUpdating = False
  With Worksheets("DATA")
    n = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
    For i = 0 To UBound(col)
      For Each c In .Range(col(i) & 2).Resize(n)
        If InStr(1, c, ",") > 0 Then
          c = Join(Split(c, ","), Chr(10))
          c.WrapText = True
        End If
      Next c
    Next i
  End With
End Sub

Private Sub suprime_apres_etoile()
  Dim tb, texte$, i&, j As Integer
  For i = 2 To Range("X" & Rows.Count).End(xlUp).Row
    tb = Split(Cells(i, "X"), Chr(10)): texte = ""
    For j = LBound(tb) To UBound(tb)
      texte = texte & Split(tb(j), "*")(0) & Chr(10)
    Next j
    Cells(i, "X") = texte
  Next i
End Sub

Sub aargh()
  Tabulations2
  Codes3
  suprime_apres_etoile
End Sub
