Macro to extend range of cells

[JohnTravolski]

I have a spreadsheet that I add rows to regularly. A particular range of these rows I copy by highlighting that range of the row above it and then dragging the plus button down in the bottom right hand corner. It's not as simple as copying the cells' values; it has to change them the exact same way it would if you do this dragging action.

I would like to automate this with a macro, but I'm not sure how to given that it always needs to find the very bottom row (but the columns never change). It should be the equivalent of doing this:

How would I write a macro to do this?

 

[yky]

Go to Developer/Record Macro, do exactly what you did in the video, stop recording, open the recorded macro. You'll see something like this:

    Range("F30:I30").Select
    Selection.AutoFill Destination:=Range("F30:I31"), Type:=xlFillDefault
    Range("F30:I31").Select

Edit it to suit your need.

 

[MARK858]

(but the columns never change)

Which columns as you don't show it in your video?

 

[JohnTravolski]

Go to Developer/Record Macro, do exactly what you did in the video, stop recording, open the recorded macro. You'll see something like this:

    Range("F30:I30").Select
    Selection.AutoFill Destination:=Range("F30:I31"), Type:=xlFillDefault
    Range("F30:I31").Select

Edit it to suit your need.

I don't think this will work since it specifies the rows in the code. It has to automatically find the last row in the sheet and extend that row specifically specifically.

Which columns as you don't show it in your video?

Let's just say columns B through D.

 

[yky]

There are several ways to find the last non-blank row. Try this:

Sub test()

Dim lrow As Double

with ActiveSheet
lrow = .Range("B1048576").End(xlUp).Row
ActiveSheet.Range("B" & lrow & ":D" & lrow).Copy Destination:=ActiveSheet.Range("B" & lrow + 1 & ":D" & lrow + 1)
End With
End Sub

 

[MARK858]

My take

Sub JohnTrav()
    Dim LstRw As Long
    LstRw = Columns("B").Find("*", , xlValues, , xlByRows, xlPrevious).Row
    Range(Cells(LstRw, "B"), Cells(LstRw, "D")).Resize(2).FillDown
    Application.Goto Cells(LstRw + 1, "E")
End Sub

or

Sub JohnTrav2()
    Dim LstRw As Long
    LstRw = Columns("B").Find("*", , xlValues, , xlByRows, xlPrevious).Row
    Cells(LstRw, "B").Resize(2, 3).FillDown
    Application.Goto Cells(LstRw + 1, "E")
End Sub

Although I would specify the sheet as well if you aren't using the Active sheet (which is why I have used Goto rather than Select, just in case you do need to reference the sheet later).

 

[JohnTravolski]

Thank you, these worked like a charm!