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

Copper Contributor
Dear team

Find attach pic i want to typw in one cell multiple number and its ahow automatically on another sheet on diffrent cells
Note that numbwr are not in series
5 Replies

I am preparing a VBA enabled sheet. Soon you will get.

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

thx for take time for me appreciate your work but dear i face attach error when i run this vba codeerror.png

Hi @HUZEFA KUKSHI,

 

Just show me the excel screenshot, then only i can solve.

 

 

its work but not like that which i want

once i fill 2 and 3 row and i run command after i type on 4 row and again i run command than 2 and 3 row serial is repeated and when i miss one row than its not work

error 2.png