excelvba

Macro to insert two rows and three columns of cells below a selected range


I have made a macro that works perfectly to insert the space that I need below a certain range. It selects the cells and then uses insert to move the data below. It then loops through to do this for another few times

Here it is;

i = 3
Do While i < 19
    Set Rng1 = Worksheets("Sheet1").Range("A" & i & ":C" & i + 1)
    Rng1.Insert Shift:=xlDown
    i = i + 3
Loop

The thing is, that when I changed it to be able to work no matter where I put this table (as it is often in different columns, but always at the furthest right) it suddenly just inserts 20 full rows and does nothing else.

i = 3
Set rng1 = Worksheets("Sheet1").Range("BZ6").End(xlToLeft).Offset(0, -2)
Do While i < 19
    Set rng2= Worksheets("Sheet1").Range(rng1.Offset(i, 0) & ":" & rng1.Offset(i + 1, 2))
    rng2.Insert Shift:=xlDown
    i = i + 3
Loop

This should be taking rng1 as the top left of the table and rng2 as the 6 cells that I wish to insert 6 cells above.

It is the first time I have tried using Offset so I might be implementing it wrong. Any help would be greatly appreciated


Solution

  • Your code is missing the word .Address :

    Set rng2= Worksheets("Sheet1").Range(rng1.Offset(i, 0).Address & ":" & rng1.Offset(i + 1, 2).Address)
    

    A shorter variant:

    Set rng2 = rng1.Offset(i, 0).Resize(2, 3)