insert rows + copy rows except certain columns

[costin]

Hi guys,

I need your help for the following problem, hope not too difficult

Presentation:
I attached the sample where we have Sheet1 and Sheet2.
In sheet1 I have a lot of rows and columns, with many formulas almost in each cell. In Sheet2 I have again formulas and so on. Important: the no of rows in Sheet 2 can vary each time I’m running the macro.

The Problem:
I have to insert rows below the active row from Sheet1 and copy/paste this row into the new inserted ones, except columns E and F which must be copied from Sheet2. The no of rows inserted is given by the no of rows from Sheet2 (except header).

Thank you all !

[AlphaFrog]

Sub Insert_Data_Rows()
    Dim RowCount As Long, r As Long
    RowCount = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row - 1
    r = ActiveCell.Row
    Application.ScreenUpdating = False
    Range("A" & r & ":F" & r).Copy
    r = r + 1
    Range("A" & r & ":F" & r).Resize(RowCount).Insert Shift:=xlShiftDown
    Range("E" & r & ":F" & r).Resize(RowCount).Value = _
        Sheets("Sheet2").Range("C2:D2").Resize(RowCount).Value
    Application.CutCopyMode = True
    Application.ScreenUpdating = True
End Sub

[costin]

What a masterpiece! Works exactly as I wanted! Many many thanks. I have to visit Florida and give you a beer

[AlphaFrog]

You're welcome.