paste the data of what the quantity is. I Wish anybody here can help me please :(

Hi,

PFA Execl Sheet attached.. I'v considered Column B to be the 1st one always..

Sub jasond1992Changed() 'http://www.excelforum.com/excel-programming-vba-macros/1115257-paste-the-data-of-what-the-quantity-is-i-wish-anybody-here-can-help-me-please.html
    
    Application.ScreenUpdating = False
    
    Dim WS As Worksheet, LR As Integer, Counter As Integer, NewWS As Worksheet, LR2 As Integer, CopyCount As Integer, LC As Byte, SHName As String, FC As Integer
    
    Set WS = ActiveSheet
    
    If WS.Range("B1") = "" Then FC = WS.Range("B1").End(xlDown).Row Else FC = 1
    
    SHName = WS.Name
    Set NewWS = Sheets.Add
    
    WS.Activate
    WS.Range(Cells(FC, 2), Cells(FC, 7)).Copy NewWS.Cells(FC, 2)
    NewWS.Activate
    
    LR = WS.Cells(Rows.Count, 2).End(xlUp).Row
    LC = WS.Cells(FC, Columns.Count).End(xlToLeft).Column
    
    For Counter = FC + 1 To LR
        LR2 = NewWS.Cells(Rows.Count, 2).End(xlUp).Row + 1
        CopyCount = WS.Cells(Counter, LC).Value
        WS.Select
        WS.Range(Cells(Counter, 2), Cells(Counter, LC)).Copy NewWS.Cells(LR2, 2)
        NewWS.Select
        NewWS.Range(Cells(LR2, 2), Cells(LR2 + CopyCount, LC)).FillDown
    Next Counter
    
    Cells(FC + 1, 2).Value = 1
    Cells(FC + 2, 2).Value = 2
    Range("B" & FC + 1 & ":B" & FC + 2).AutoFill Destination:=Range("B" & FC + 1 & ":B" & Cells(Rows.Count, 2).End(xlUp).Row)
    
    Range("G" & FC + 1 & ":G" & Cells(Rows.Count, 2).End(xlUp).Row).Value = 1
    
    Application.DisplayAlerts = False
    NewWS.Cells.EntireColumn.AutoFit
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 392.25, 118.5, 60, 27.75).Select
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "RUN"
    Selection.OnAction = "jasond1992Changed"
    Range("A1").Select
    Sheets(SHName).Delete
    NewWS.Name = SHName
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

Please excuse my poor coding for this instance..