Habe nochmal getestet, allerdings bin ich bei meinem Lauf nicht auf das gleiche Ergebnis gekommen, wie bei Dir,

habe mich hier nur um die Schleife gekümmert, was das angeht, funktioniert es.

Sub Baumdurchmesser4()

Dim rngCell As Range
Dim blnErr As Boolean
Dim n As Long
Dim lngZeile As Long, lngLetzte As Long
Dim strStartSpalte As String
Dim lngStartZeile As Long

On Error GoTo errhandler

With Sheets("Tabelle1")
    
    strStartSpalte = "B"
    lngStartZeile = 2
    
    lngLetzte = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row 'letze in Spalte 'B' beschriebene Zeile

    For lngZeile = lngStartZeile To lngLetzte
        
        Set rngCell = .Cells(lngZeile, strStartSpalte) 'Startzelle in jeder Zeile

        With rngCell
            'reduziere den Zelleninhalt auf den Teil zwischen 'c' und '-'
            .Value = Mid$(.Value, InStr(.Value, "c") + 1, InStr(.Value, "-") - InStr(.Value, "c") - 1)
            'verw. Excel-Funktion: Daten -> TextInSpalten
            Call .TextToColumns(rngCell, xlDelimited, Other:=True, OtherChar:="+")
        End With
        
        On Error GoTo 0 'Fehlerunterdrückung: AUS
  
        'im folgenden wird solange Zelle um Zelle weiter nach rechts gesprungen
        'bis jene Zelle keinen Inhalt mehr hat, dabei wird ggf. der Faktor vor '*' behandelt
        Do While rngCell <> ""
            'schaue ob Zelle ein '*' beinhaltet
            n = InStr(1, rngCell.Value, "*")
                  
            'als nächstes wird ggf. der Zelleninhalt zerlegt
            'Inhalt Bsp: 3*0,5 wird zu: [n:=3] * [Ausdruck:=0,5]
            'entsprechend zu n werden zustäzliche Zellen eingefügt und mit Ausdruck belegt
            '(andere Daten werden dabei nach rechts verschoben)
                  
            If n > 0 Then
                'On Error Resume Next 'Fehlerunterdrückung: AN
                On Error GoTo ExitDo
                n = Left(rngCell.Value, n - 1)
                If Err.Number <> 0 Then
                  On Error GoTo 0 'Fehlerunterdrückung: AUS
                  blnErr = True
                  n = 1
                ElseIf n > 1 Then
                  'Zelleninhalt um den Ausdruck 'n*' kürzen
                  rngCell.Value = Mid(rngCell.Value, InStr(1, rngCell.Value, "*") + 1)
                  rngCell.Value = rngCell.Value * 1 'versuche Zelleninhalt als Zahl zu formatieren
                  On Error GoTo 0 'Fehlerunterdrückung: AUS
                  'füge zusätzlichen Zellen ein
                  Call rngCell.Resize(, n - 1).Offset(, 1).Insert(xlShiftToRight)
                  rngCell.Resize(, n).Value = rngCell.Value 'kopiere Inhalt auf Zellen
                End If
            Else
                n = 1
            End If
            Set rngCell = rngCell.Offset(0, 1)  'rngCell um Offset(Zeile,Spalte) versetzen
ExitDo:
        Loop
    Next lngZeile
End With

Exit Sub

errhandler:
    MsgBox "Fehlernr:" & Err.Number & " " & Err.Description
End Sub