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..
Bookmarks