Attribute VB_Name = "Fred"
Option Explicit

Dim tablo, tabloR()
Dim i&, n&, nbrC&, nb&, nbD, k&, col$, nCol&

Sub aargh()
Attribute aargh.VB_ProcData.VB_Invoke_Func = "w\n14"
   
    Tabulations2
    Codes3
    suprime_apres_etoile
       
       
End Sub
Sub suprime_apres_etoile()
Dim i, j As Integer
Dim tb
Dim texte As String

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 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


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


