Insert Lines in a range, then move data into the inserted line

[A1floodtech]

Hello,

I need to do two things, can be two seperate macro's. 1. I need to insert a blank row every other row in a selected range. 2. Then I need to move the data from Column G into column B in the newly created rows.

The number of rows I have varies each month.
Sample is I have 80 rows of data, columns A-G.
I need to insert a row between each existing row.
Then I need to move what is in column G into column B on the newly inserted row.


I found a macro on microsoft to insert rows, but it ignores the selected range and inserts a row down the entire dataset.

Sub InsertRows()
Dim r As Long
Dim m As Long
Application.ScreenUpdating = False
m = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For r = m To 2 Step -1
Cells(r, 1).EntireRow.Insert
Next r
Application.ScreenUpdating = True
End Sub



Thanks, Keith

 

[MARK858]

For the 1st part try

Sub InsArows()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim i As Integer
    For i = Selection(Selection.Count).Row To Selection(1).Row + 1 Step -1
        Rows(i).EntireRow.Insert
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Just going offline for the day but being honest I can't picture what you are trying to do with part 2 and so I think you will need to elaborate a bit more on what is required.

 

[MARK858]

On reading your post again I think you might mean something like the code below for part 2. Please note it assumes that the only blank cells in column B are in the empty rows created by the previous code.

Sub insertG()
    Dim c As Range
    For Each c In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
        If c = vbNullString Then
            c.Value = c.Offset(-1, 5).Value
        End If
    Next
End Sub

 

[A1floodtech]

Worked perfectly. Thanks