Macro to copy paste down- Help

[Muhammad Shakeel Ishaq]

Hi Dear Friends,

i hope you all are fine and doing great.

I am using this macro for copy pasting cell down according to number given:

Sub SmileyFace1_Click()
Dim lRow As Long
Dim RepeatFactor As Variant

lRow = 1
Do While (Cells(lRow, "A") <> "")

RepeatFactor = Cells(lRow, "C")
If ((RepeatFactor > 1) And IsNumeric(RepeatFactor)) Then

Range(Cells(lRow, "A"), Cells(lRow, "C")).Copy
Range(Cells(lRow + 1, "A"), Cells(lRow + RepeatFactor - 1, "C")).Select
Selection.Insert Shift:=xlDown

lRow = lRow + RepeatFactor - 1
End If

lRow = lRow + 1
Loop
End Sub


My data is as following:

SANCT_NO Amount No
TLB-00001-E 10,000 10
TLB-00002-E 15,000 15
TLB-00003-E 18,000 12

When i use macro, It divides amount according number, Like 1000 each and spread over ten rows etc. I need your help as i need it divide result in 10 rows and also show number as 1,2,3....in rows.

I have also attached the file for your kind consideration.


Many Thanks,
Shakeel

 

[Nebu]

Hi:

Try the below code

Sub SmileyFace1_Click()

Dim lRow As Long
Dim RepeatFactor As Variant
Dim rng As Range
   
    lRow = 1
    Do While (Cells(lRow, "A") <> "")
       
        RepeatFactor = Cells(lRow, "C")
        If ((RepeatFactor > 1) And IsNumeric(RepeatFactor)) Then
          Range(Cells(lRow, "A"), Cells(lRow, "C")).Copy
          Range(Cells(lRow + 1, "A"), Cells(lRow + RepeatFactor - 1, "C")).Select
          Selection.Insert Shift:=xlDown
          Set rng = Range(Cells(lRow, 3), Cells(RepeatFactor + lRow, 3))
          Cells(lRow, 3) = 1
          rng.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
          Step:=1, stop:=RepeatFactor, Trend:=False
          lRow = lRow + RepeatFactor - 1
        End If
   
        lRow = lRow + 1
    Loop
   
End Sub

Thanks

 

[Muhammad Shakeel Ishaq]

thank you, great