Items staan in één cel namelijk A1. En er is sprake van tekst terugloop door voor elk nieuw item eerst Alt+ Enter te geven. Hierdoor komt elk item op een nieuwe regel. We willen die items echter splitsen en elk item in een eigen cel plaatsen zodat het overzichtelijker wordt. Zie screenshot:

Dit kan op 4 manieren:
– Met een simpele formule die je in B1 invoert en vervolgens naar rechts sleept (2x)
– Met VBA (2x)

In[B1] =TRIM(MID(SUBSTITUTE($A1; CHAR(10); REPT(" "; 100)); (COLUMN(A1)-1)*100+1; 100))
en naar rechts slepen.

1. Kopieer de onderstaande code
2. Open een nieuwe werkmap
3. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
4. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
5. Druk op M om een standaard module in te voegen
6. Daar waar de cursor knippert voeg je de code in middels Ctrl + V
7. Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel

Function SplitText(ByVal Cell As Range, ByVal LineNumber As Integer) As String
    Dim Lines As Variant
    Lines = Split(Cell.Value, Chr(10))
    If LineNumber - 1 <= UBound(Lines) Then
        SplitText = Lines(LineNumber - 1)
    Else
        SplitText = ""
    End If
End Function

Aangezien dit een functie is moet je nog één ding doen namelijk in B1 de volgende formule zetten:

In[B1] =SplitText($A1; COLUMN()-1)
en naar rechts slepen.

En de derde manier is ook VBA code:

Option Explicit
Sub Tekst_Terugloop_Van_Cel_Naar_Rij()
    Dim WsNieuw As Worksheet, rngBereik As Range
    Dim lngRij As Long, lngKolom As Long, lngVolgende As Long
    Dim lngTeller As Long, Data As Variant
    
    'Nieuw werkblad invoegen
    Set WsNieuw = Worksheets.Add
    
    'rngBereik is waar de gegevens staan
    With Worksheets("Sheet1")
        Set rngBereik = .Range("A1").CurrentRegion
        
        'Eerste rij met kolomtitels kopiëren
        rngBereik.Rows(1).Copy WsNieuw.Range("A1")
        lngVolgende = 2
        With rngBereik
            
            'Alle rijen doorlopen
            For lngRij = 2 To .Rows.Count
                lngTeller = 0
                
                'Alle kolommen doorlopen
                For lngKolom = 1 To .Columns.Count
                    
                    'Gegevens in cel splitsen
                    Data = Split(.Cells(lngRij, lngKolom).Value, _
                    Chr(10))
                    
                    'Gespliste gegevens wegschrijven naar rijen
                    WsNieuw.Cells(lngVolgende, lngKolom).Resize _
                    (UBound(Data) + 1).Value = Application.Transpose(Data)
                    
                    lngTeller = WorksheetFunction.Max(lngTeller, _
                    UBound(Data) + 1)
                Next lngKolom
                lngVolgende = lngVolgende + lngTeller
            Next lngRij
        End With
    End With
    WsNieuw.Cells.EntireColumn.AutoFit
End Sub

En de vierde manier:

in [B1] =TRIM(MID(SUBSTITUTE($A1;CHAR(10); REPT(" ";99));COLUMNS($A:A)*99-98;99))
en naar rechts slepen.