VBA insert 2 blank rows between each row in range

  • Hi everybody,


    I hope that somebody could help me with my VBA code. I'm still learning it and I'm stuck at the moment with this problem.
    I'm trying to find out how to insert 2 blank rows between each row in my range of data. I can't work it out how to correctly write the code.
    My range starts from cell B6, has 4 columns and number of rows is going to change. I don't know how to do it to keep first row in row 6 and the rest of the range should move down.
    All codes I've found moved the first row down from row 6.


    Thanks a lot.


    Theres

  • Re: VBA insert 2 blank rows between each row in range


    Welcome to board !!!


    [vb]Option Explicit


    Sub kTest()

    Dim LastRow As Long
    Dim r As Range

    With ActiveSheet
    LastRow = Range("b" & .Rows.Count).End(xlUp).Row
    .Columns(2).Insert 'a temporary column
    .Range("b7").Value = 1
    Set r = .Range("b7:b" & LastRow)
    .Range("b7").AutoFill r, xlFillSeries 'fill serial number till the last row
    r.Copy .Range("b" & LastRow + 1) 'copy the numbers below the last row
    LastRow = Range("b" & .Rows.Count).End(xlUp).Row
    r.Copy .Range("b" & LastRow + 1) 'repeat the action 1 more time
    'now sort the whole range
    LastRow = Range("b" & .Rows.Count).End(xlUp).Row
    Set r = .Range("b7:f" & LastRow)
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Range("B7"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
    .SetRange r
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    .Columns(2).Delete
    End With

    End Sub[/vb]

  • Re: VBA insert 2 blank rows between each row in range


    nice code, here is a simple one