Home > database >  Simultaneously copying down the contents of 2 selected, adjacent cells to the last row of a table
Simultaneously copying down the contents of 2 selected, adjacent cells to the last row of a table

Time:04-22

I have seen several articles showing how to do this with a specified cell range, but I need to be able to do this with a variable range (whatever range is selected). I am at the point in my macro where there are two cells right next to each other with a formula that needs to be copied down to the end of the table based on how far column A goes (the active cells are in columns B and C). The code I am trying is as follows:

ActiveCell.Resize(1, 2).Select <--Selects the two cells containing a formula in columns B and C. 
Set rng = Selection
Selection.AutoFill Destination:=Range("rng" & Range("A" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select

This gives an error. I think the problem is with the "rng" but I can't specify something like "3B:50C" because the starting point cells in column B and C could be different row each time this runs. Any help would be appreciated. Thank you so much!

CodePudding user response:

Like this:

Dim lr As Long, ws As Worksheet, c As Range

If TypeName(Selection) <> "Range" Then Exit Sub 'make sure a range is selected
Set c = Selection.Cells(1)                      'get the top-left cell
Set ws = c.Worksheet                            'parent worksheet

lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'last occupied row in ColA
c.Resize(1, 2).AutoFill Destination:=ws.Range(ActiveCell, ws.Cells(lr, c.Column   1))


  • Related