Hallo Ronja,

eigentlich ist das ein klassischer Fall für Auftragsprogrammierung. Es gibt Programmierer die dadurch ihre Brötchen verdienen. Denen könntet ihr ruhig ein paar Kröten zukommen lassen. Da es aber nicht allzuschwer war hab ich mich mal mit dran gesetzt. Ein paar Fragen sind aufgekommen: Hat es einen Grund, dass das Wort *Beschreibung* im zweiten Datensatz fehlt? Wie sieht z.B. ein Link zum Investitionsdatenblatt genau aus? Wird hier ein Hyperlink benötigt?, warum ist dieser nicht im Feld Anmerkung deiner Zieltabelle enthalten?, und was ist h1?

Ansonsten probier mal den folgenden Code:

Sub Aufsplitten()
  
  Const Überschrift = 4 'Zeile für Überschrift
  
  'Spaltennunmmern angeben
  Const Beschreibung = 7, Zielgruppe = 8, Kanäle = 9
  Const Risikoklasse = 10, Finanzklasse = 11, Anmerkung = 12
  
  Dim lzei As Long, r As Range, c As Range, s As Variant, t As Variant, Spalte As Long
  
  'letzte Zeile ermitteln
  lzei = Cells(Rows.Count, 1).End(xlUp).Row
  Set r = Range(Cells(Überschrift + 1, Beschreibung - 1), Cells(lzei, Beschreibung - 1))
  
  Cells(Überschrift, Beschreibung) = "Beschreibung"
  Cells(Überschrift, Zielgruppe) = "Zielgruppe und Kundenanzahl"
  Cells(Überschrift, Kanäle) = "Kanäle"
  Cells(Überschrift, Risikoklasse) = "Risikoklasse"
  Cells(Überschrift, Finanzklasse) = "Finanzklasse"
  Cells(Überschrift, Anmerkung) = "Anmerkung"
  Range(Cells(Überschrift, Beschreibung), Cells(Überschrift, Anmerkung)).Font.Bold = True
  With Range(Cells(Überschrift, Beschreibung), Cells(lzei, Anmerkung))
    For i = 7 To 12
      .Borders(i).LineStyle = xlContinuous
    Next i
  End With
  
  For Each c In r.Cells
    Spalte = Beschreibung
    s = Split(c, Chr(10))
    For Each t In s
      If Left(t, 1) = "*" Then
        Select Case t
        Case "*Beschreibung*"
          Spalte = Beschreibung
        Case "*Zielgruppe und Kundenanzahl*"
          Spalte = Zielgruppe
        Case "*Kanäle*"
          Spalte = Kanäle
        Case "*Risikoklasse*"
          Spalte = Risikoklasse
        Case "*Finanzklasse*"
          Spalte = Finanzklasse
        Case "*Anmerkung*"
          Spalte = Anmerkung
        End Select
      ElseIf Trim(t) <> "" Then
        If Cells(c.Row, Spalte) = "" Then
          Cells(c.Row, Spalte) = t
        Else
          Cells(c.Row, Spalte) = Cells(c.Row, Spalte) & Chr(10) & t
        End If
      End If
    Next t
  Next c
  
  Columns(Beschreibung - 1).Delete
  Range(Cells(1, Beschreibung), Cells(Rows.Count, Anmerkung)).EntireColumn.AutoFit
  Range(Cells(Überschrift, 1), Cells(lzei, Columns.Count)).EntireRow.AutoFit
  
End Sub

den Linestyle der Rahmen musst du evtl. noch deinen Wünschen anpassen.

Gruß Mr. K.