Dividere contenuto cella in più celle Excel

Ho bisogno di dividere le celle presenti nel file allegato, dove per ogni cella deve corrispondere un fondo. Con lo strumento “testo in colonne” non riesco perché essendo il contenuto della cella “testo a capo” e come se tutti i nomi dei fondi fossero uniti e quindi senza spazi.

Soluzione 1: sub() costruita e poi adattata con il registratore di macro da inserire nel foglio in questione.
Procedura:
1 crea un nuovo testo dove al posto di ritorno a capo metto un altro simbolo
2 copio la colonna B:B modificata in C:C solo valori
3 sulla colonna C:C eseguo il comando — testo in colonne — confermando quello che mi viene richiesto

Sub Macro1()

    Range("B1").Select
      ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-1],CHAR(10),"""")"
    Range("B1").Select
    Selection.Copy
    
    Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row).Select
    ActiveSheet.Paste
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("C:C").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
End Sub

Soluzione2:

Option Explicit
Sub splitta()
Dim vSplit As Variant
Dim i As Long, x As Long, k As Long, z As Long
x = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To x
  vSplit = Split(Cells(i, 1), Chr(10))
  If UBound(vSplit) > 0 Then
    For k = 0 To UBound(vSplit)
      z = Range("B" & Rows.Count).End(xlUp).Row + 1
      Cells(z, 2) = vSplit(k)
    Next k
  Else
    z = Range("B" & Rows.Count).End(xlUp).Row + 1
    Cells(z, 2) = vSplit(0)
  End If
Next i
End Sub


Soluzione3:

Sub test()
Dim R As Long, I As Long, S As Variant, Cella As Range
    Application.ScreenUpdating = False
    R = 2
    For Each Cella In Range("A2", Range("A2").End(xlDown))
        S = Split(Cella, vbLf)
        For I = LBound(S) To UBound(S)
            Cells(R, 2) = S(I)
            R = R + 1
        Next I
    Next Cella
    Application.ScreenUpdating = True
End Sub