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

Good Evening Excel Forum. I have a problem anybody can help me ?? Is it posible to put the data of what is the quantity in Cell "F" is. in sheet 1 is the data. in Sheet 2 is the Result what i want. I wish Anyone Here can help. GODBLESS Always This Forum. This Forum is really help to. Godbless Again. BLess This Forum it's Really help

Give this a try -

Sub jasond1992() '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
    
    Set WS = Sheets("Sheet1")
    Set NewWS = Sheets.Add
    
    WS.Rows("1:1").Copy ActiveSheet.Range("A1")
    
    LR = WS.Cells(Rows.Count, 1).End(xlUp).Row
    LC = WS.Cells(1, Columns.Count).End(xlToLeft).Column
    
    For Counter = 2 To LR
        LR2 = NewWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
        CopyCount = WS.Cells(Counter, LC).Value
        WS.Select
        WS.Range(Cells(Counter, 1), Cells(Counter, LC)).Copy NewWS.Cells(LR2, 1)
        NewWS.Select
        NewWS.Range(Cells(LR2, 1), Cells(LR2 + CopyCount, LC)).FillDown
    Next Counter
    
    NewWS.Cells.EntireColumn.AutoFit
    
    Application.ScreenUpdating = True
    
End Sub

See the file attached.

Originally Posted by jasond1992

And sir the result is excess 1 not exactly what the quantity is sir. Sorry for the Grammar sir. I really appreciate your help sir NeepForExcel I wish you can help this will really help me so much. GODBLESS Again Sir.

I am not sure what that means.. Can you explain a bit more?

But why is it 11 data?

My code generates the line number of times thats mentioned in the quantity column.. Is it not how you want it?

Please see post#7

The result in my sheet is 10, not 11..

Try this code -

Sub jasond1992() '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
    
    Set WS = Sheets("Sheet1")
    SHName = WS.Name
    Set NewWS = Sheets.Add
    
    WS.Rows("1:1").Copy ActiveSheet.Range("A1")
    
    LR = WS.Cells(Rows.Count, 1).End(xlUp).Row
    LC = WS.Cells(1, Columns.Count).End(xlToLeft).Column
    
    For Counter = 2 To LR
        LR2 = NewWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
        CopyCount = WS.Cells(Counter, LC).Value
        WS.Select
        WS.Range(Cells(Counter, 1), Cells(Counter, LC)).Copy NewWS.Cells(LR2, 1)
        NewWS.Select
        NewWS.Range(Cells(LR2, 1), Cells(LR2 + CopyCount, LC)).FillDown
    Next Counter
    
    Range("A2").Value = 1
    Range("A3").Value = 2
    Range("A2:A3").AutoFill Destination:=Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    
    Range("F2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value = 1
    
    Application.DisplayAlerts = False
    NewWS.Cells.EntireColumn.AutoFit
    Sheets(SHName).Delete
    NewWS.Name = SHName
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

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

Please attach your workbook with your actual data range.. Ill help you out with the code