VBA to copy a cell defined value down a colum a cell defined amount of times

[Eean]

Hope the title's not too confusing.
I'm trying to write a Macro that will take the value in B6 and copy it to a new sheet in cell A1 and copy it down the column based on the value in cell C6. Then do the dame for B7 /C7 and so on. I also need to add a set value into Column S for each line
E.g.
Sheet 1:
B6 = 20
C6 =5
B7 = 10
C7 = 2

Sheet 2 Should look like this:
A1=20 S1=SC01
A2=20 S2=SC01
A3=20 S2=SC01
A4=20 S2=SC01
A5=20 S2=SC01
A6=10 S2=SC01
A7=10 S2=SC01

Can you help?

 

[Jeffrey Lopez]

I am guessing someone will come along and give you something more elegant, but this should work for you...

Its just a simple loop:

First we are taking the value in B6/B7 and assigning them as values...

For Each rngCell In Range("B6:B12") ' Set your Range here
    lngTotal = rngCell.Offset(0, 1).Value

Next we just need to find the last row, I threw an IF in to account for A1 and finding the last row and overwritting the info...

        If Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row > 1 Then
            lngLstRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
        Else
            lngLstRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
        End If

Next is another loop. So we are taking each of the values and going to copy it X (B7) number of times and paste it onto Sheet2 in the A column, as well as add your constant value. Then we just increase the last row calculation by 1 to keep it moving down.

    For i = 1 To lngTotal
        rngCell.Copy Destination:=Sheets("Sheet2").Range("A" & lngLstRow)
        Sheets("Sheet2").Range("B" & lngLstRow).Value = "SC01" ' Set your Value here
        lngLstRow = lngLstRow + 1
    Next i

And that is about it...

Hope this helps, and please back up your excel workbook before running this macro!

Sub MovingOnDown()


Dim rngCell As Range
Dim lngTotal As Long
Dim lngLstRow As Long


For Each rngCell In Range("B6:B12") ' Set your Range here
    lngTotal = rngCell.Offset(0, 1).Value
        If Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row > 1 Then
            lngLstRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
        Else
            lngLstRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
        End If
    For i = 1 To lngTotal
        rngCell.Copy Destination:=Sheets("Sheet2").Range("A" & lngLstRow)
        Sheets("Sheet2").Range("B" & lngLstRow).Value = "SC01" ' Set your Value here
        lngLstRow = lngLstRow + 1
    Next i
Next


End Sub

 

[Eean]

I am guessing someone will come along and give you something more elegant, but this should work for you...

Its just a simple loop:

First we are taking the value in B6/B7 and assigning them as values...

For Each rngCell In Range("B6:B12") ' Set your Range here
    lngTotal = rngCell.Offset(0, 1).Value

Next we just need to find the last row, I threw an IF in to account for A1 and finding the last row and overwritting the info...

        If Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row > 1 Then
            lngLstRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
        Else
            lngLstRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
        End If

Next is another loop. So we are taking each of the values and going to copy it X (B7) number of times and paste it onto Sheet2 in the A column, as well as add your constant value. Then we just increase the last row calculation by 1 to keep it moving down.

    For i = 1 To lngTotal
        rngCell.Copy Destination:=Sheets("Sheet2").Range("A" & lngLstRow)
        Sheets("Sheet2").Range("B" & lngLstRow).Value = "SC01" ' Set your Value here
        lngLstRow = lngLstRow + 1
    Next i

And that is about it...

Hope this helps, and please back up your excel workbook before running this macro!

Sub MovingOnDown()


Dim rngCell As Range
Dim lngTotal As Long
Dim lngLstRow As Long


For Each rngCell In Range("B6:B12") ' Set your Range here
    lngTotal = rngCell.Offset(0, 1).Value
        If Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row > 1 Then
            lngLstRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
        Else
            lngLstRow = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
        End If
    For i = 1 To lngTotal
        rngCell.Copy Destination:=Sheets("Sheet2").Range("A" & lngLstRow)
        Sheets("Sheet2").Range("B" & lngLstRow).Value = "SC01" ' Set your Value here
        lngLstRow = lngLstRow + 1
    Next i
Next


End Sub

That's brilliant!
I love how you broke that down - I'm learning as I go so seeing it in stages is really helpful. Great answer!