[SOLVED] Insert two rows and three columns of cells below a selected range

Insert two rows and three columns of cells below a selected range

I made a macro 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 a few times.

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

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).
Now it 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.

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)