Copy the last row n times…

Answered

Hi all,

I have the one heading and for records in a worksheet. Column F has the number times the record has to be paid.

Name| Language| Level| WEF Date| Amount | NoOfPays| Reference
JD1| Japanese| Advanced| 15-Dec-15| $2,147.00| 3| JD1JA
JD1| Japanese| Advanced| 15-Dec-16| $2,147.00| 2| JD1JA
JD1| Japanese| Advanced| 15-Dec-17| $2,147.00| 1| JD1JA
JD2| Indonesian| Lower| 12-Jan-14| $2,004.00| 5| JD2IL

I want to copy the last record 4 times

Name| Language| Level| WEF Date| Amount | NoOfPays| Reference
JD1| Japanese| Advanced| 15-Dec-15| $2,147.00| 3| JD1JA
JD1| Japanese| Advanced| 15-Dec-16| $2,147.00| 2| JD1JA
JD1| Japanese| Advanced| 15-Dec-17| $2,147.00| 1| JD1JA
JD2| Indonesian| Lower| 12-Jan-14| $2,004.00| 5| JD2IL
JD2| Indonesian| Lower| 12-Jan-15| $- | 4| JD2IL
JD2| Indonesian| Lower| 12-Jan-16| $- | 3| JD2IL
JD2| Indonesian| Lower| 12-Jan-17| $- | 2| JD2IL
JD2| Indonesian| Lower| 12-Jan-18| $- | 1| JD2IL

Please help me with this.

 

Regards

Raghu

 

Expert Asked on January 20, 2018 in Excel: General.
Add Comment
5 Answer(s)
Best answer

Hello

Try this code

Sub Test()
Dim m As Integer
Dim n As Integer
Dim i As Integer
Dim x As Integer
Application.ScreenUpdating = False
m = Cells(Rows.Count, 1).End(xlUp).Row
n = Cells(m, 6).Value
For i = n - 1 To 1 Step -1
Range(Cells(m, 1), Cells(m, 7)).Copy
Range("A" & m + x + 1).PasteSpecial xlPasteAll
Range("F" & m + x + 1).Value = i
x = x + 1
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Expert Answered on January 24, 2018.
Add Comment

This macro will copy the last line and paste it 4 times.

RE: Copy the last row n times...

Sub cpy4tms()
Dim i As Integer
i = 1
Sheets(“Sheet1”).Cells(Rows.Count, 1).End(xlUp).Select

Range(ActiveCell, ActiveCell.Offset(0, 6)).Copy
For i = 1 To 4
ActiveCell.Offset(1).Select
ActiveSheet.Paste
Next i
Application.CutCopyMode = False
End Sub

Expert Answered on January 24, 2018.
Add Comment

The will also count down in column “F”.  Please try it.

RE: Copy the last row n times...

Sub nexnumber()
Dim i As Integer
Dim rng As Range
Dim x As Integer
Dim r As Variant

i = 1
If Cells(2, 6) <= 1 Then GoTo Line1
x = Sheets(“Sheet1”).Cells(Rows.Count, 6).End(xlUp) – 1

Sheets(“Sheet1”).Cells(Rows.Count, 1).End(xlUp).Select
Set rng = Range(ActiveCell, ActiveCell.End(xlToRight))
rng.Copy
r = Sheets(“Sheet1”).Cells(Rows.Count, 6).End(xlUp)
For i = 1 To x
ActiveCell.Offset(1).Select
ActiveSheet.Paste
ActiveCell.Offset(0, 5).Value = r – 1
r = Sheets(“Sheet1”).Cells(Rows.Count, 6).End(xlUp)
Next i

Line1:
Application.CutCopyMode = False
End Sub

Expert Answered on January 24, 2018.
Add Comment

Thanks to YasserKhalil and Hyside2.

 

I played with both your codes and modified to suit my requirement.

[Code]

Sub CopyNTimesFinal()

Dim Z As Integer
Dim LastRow As Integer

Dim Y As Integer
Dim M As Integer
Dim D As Integer
Dim A As Double

LastRow = Cells(Rows.Count, 6).End(xlUp).Row
Range(“A” & LastRow).Select

Z = ActiveCell.Offset(0, 5).Value – 1

If Z = 0 Then
Exit Sub
End If

Y = Year(ActiveCell.Offset(0, 3).Value)
M = Month(ActiveCell.Offset(0, 3).Value)
D = Day(ActiveCell.Offset(0, 3).Value)

Do While ActiveCell.Offset(0, 5).Value > 1
Y = Y + 1
ActiveCell.Offset(1, 0).Select
Range(“A” & ActiveCell.Row – 1 & “:G” & ActiveCell.Row).FillDown
A = ActiveCell.Offset(0, 4).Value

With ActiveCell
.Offset(0, 3).Value = DateSerial(Y, M, D)
.Offset(0, 4).Value = Round(A * 1.02, 2)
.Offset(0, 5).Value = Z
End With
Z = Z – 1
Loop

End Sub

[/Code]

Expert Answered on January 25, 2018.
Add Comment

You’re welcome. Glad we can offer some help

Expert Answered on January 25, 2018.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.