Need A Macro that takes comma delimited values in select columns and seperates them to row

Assume columns C & E shall not be split; B, D & F are split

Option Explicit
Sub Split_BDF()

    Dim ArrPtr      As Long, _
        RecCount    As Long, _
        MaxBD       As Long, _
        DestRow     As Long, _
        Split_B()   As String, _
        Split_D()   As String, _
        Split_F()   As String, _
        TestCell    As Variant, _
        DEST        As Worksheet, _
        SOURCE      As Worksheet

    Set SOURCE = Sheets("Sheet1")
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Workspace").Delete
    On Error GoTo 0
    
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "WorkSpace"
    Set DEST = ActiveSheet
    Application.DisplayAlerts = True
    
    With SOURCE
        RecCount = .Cells(.Rows.Count, "A").End(xlUp).Row

        For Each TestCell In .Range("A1:A" & RecCount)
            'columns B, D & F shall be split
            Split_B = Split(TestCell.Offset(columnoffset:=1).Value, ",")
            Split_D = Split(TestCell.Offset(columnoffset:=3).Value, ",")
            Split_F = Split(TestCell.Offset(columnoffset:=5).Value, ",")
            
            'get the larger upper bound of the two arrays
            MaxBD = WorksheetFunction.Max(UBound(Split_B), UBound(Split_D), UBound(Split_F))
            
            'make both arrays same size
            'the previously smaller one will have a blank last element
            
            ReDim Preserve Split_B(0 To MaxBD)
            ReDim Preserve Split_D(0 To MaxBD)
            ReDim Preserve Split_F(0 To MaxBD)
            
            For ArrPtr = 0 To MaxBD
                DestRow = DestRow + 1
                
                'write column A, C & E once only for each group
                If ArrPtr = 0 Then
                    DEST.Cells(DestRow, "A").Value = TestCell.Value
                    DEST.Cells(DestRow, "C").Value = TestCell.Offset(columnoffset:=2).Value
                    DEST.Cells(DestRow, "E").Value = TestCell.Offset(columnoffset:=4).Value
                End If
                
                'write all array elements
                DEST.Cells(DestRow, "B").Value = Split_B(ArrPtr)
                DEST.Cells(DestRow, "D").Value = Split_D(ArrPtr)
                DEST.Cells(DestRow, "F").Value = Split_F(ArrPtr)
            Next ArrPtr
        Next TestCell
    End With     'SOURCE
End Sub