type multiple number in one cell and extract it on another sheet

Open Visual Basic Editor

Insert New Module

Paste the VBA Code given below.

Hope you like.

Sub Macro1()
'
' Macro1 Macro
'

'

Dim a, b, c, d, i As Integer

    Range("H1").Select
    ActiveCell.Formula = "=COUNTA(A:A)"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Range("I1").Select
    ActiveCell.Formula = "=COUNTA(E:E)+1"
    
a = Range("H1").Value

    Range("B2:B" & a).Select
    Selection.Copy
    Range("H2").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    Selection.TextToColumns Destination:=Range("H2"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(RC[1]:RC[26])+7"
    Range("G2:G" & a).Select
    Selection.FillDown
    Selection.Copy
    ActiveSheet.Paste
    Application.CutCopyMode = False

c = 2
For c = 2 To a
b = Cells(c, 7).Value
Range(Cells(c, 8), Cells(c, b)).Select
Selection.Copy
d = Cells(1, 9).Value
Cells(d, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Next c

c = 2
For c = 2 To a
b = Cells(c, 7).Value
Range(Cells(c, 8), Cells(c, b)).Select
Selection.Value = Cells(c, 1).Value
Next c

Range("I1").Select
ActiveCell.Formula = "=COUNTA(D:D)+1"

c = 2
For c = 2 To a
b = Cells(c, 7).Value
Range(Cells(c, 8), Cells(c, b)).Select
Selection.Copy
d = Cells(1, 9).Value
Cells(d, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Next c

Columns("G:L").Select
Selection.ClearContents

Cells(2, 4).Select

End Sub