VB, Excel 2007, Issue with autofill & copy

Range("D2").Select
ActiveCell.FormulaR1C1 = "1"
Selection.AutoFill Destination:=Range("D2:D6"), Type:=xlFillSeries
Range("D2:D6").Select
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Selection.Copy Destination:=Range("D7:D" & lastrow)

I'm want to:

1. autofill D2 to D6 numbers 1-5 then
2. Copy cells D2-D6 and copy down to last row
3. Using Col B to find the last row

From above code it copies D2-D6 (#1-5) to next 5 cells, D7-D11 only.

How do I copy to last row?

Thanks,
weenie

on my screen shows blue emojis in between D2. Not sure why but here it is D2 to D6 then "D7:D"

Code:

---

Option Explicit

Sub test()
    Dim lastrow  As Long
    Dim i As Long
    Dim n As Long

    lastrow = Cells(Rows.Count, 2).End(xlUp).Row
   
    For i = 2 To lastrow
        Cells(i, "d").Value = n Mod 5 + 1
        n = n + 1
    Next

End Sub

---

Thank you! Appreciate your help. It worked beautifully

weenie

Hi Weenie
For clarification.
Your code will work if LastRow cell value will be 5, e.g Row 26.
Try to avoid Selecting cells. This will "overfill" the range to complete the sequence

Code:

---

Sub Test()
    Dim c As Range
    Dim LastRow As Long, i As Long
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Set c = Range("D2")
    c = 1
    c.AutoFill Destination:=c.Resize(5), Type:=xlFillSeries
    For i = 5 To LastRow Step 5
    c.Resize(5).Copy c.Offset(i)
    Next
End Sub

---

Thank you.

weenie