Insert Row automatically with formula

[uday]

Hi,

I want a VBA code that will automatically insert a new row with formula. The formula will be copied down from previous row.

The challenge is I am downloading raw input file everyday and I need to copy the data from raw file to dedicated template which has a particular format. But everyday I am inserting and deleting row as per the raw input data.

I need a VBA code that will automatically inserting new row with formula for the entire mentioned columns which are A,B,C,D,E.

I have attached one sample file wherein sheet1 has particular format. In E column there is formula. In sheet2 I have to dump the data from the raw input file. Currently sheet2 has 3 line items. If it is increase by 2 line items the details should be automatically transfered to the sheet1.

 

[Deepak]

Check this..

To make it automatic manipulate with worksheet_change event.

Sub test()
Dim r As Integer

With Sheet1.[A1].CurrentRegion
    .Offset(1).Resize(.Rows.Count - 1, 4).Cells.Clear
End With

With Sheet2.[A1].CurrentRegion
r = .Rows.Count
    .Offset(1).Resize(r - 1).Copy
    Sheet1.[A2].PasteSpecial xlValue
End With

Application.CutCopyMode = False

Sheet1.Range("e2:e" & r) = "=C2*D2"

End Sub

 

[uday]

Hi Deepak,

Thanks for your prompt response. It is working but in 8th and 9th rows I have a details of cash and cash equivalent, when I am increasing the data of column A,B,C,D, it's overlapping the cash and cash equivalent data. I want two rows gap from upper region data. I need to keep the data of cash and cash equivalent data.

 

[Deepak]

Oh!!

Check this!

Sub test1()
Dim copy_rng As Range, ws As Worksheet
Dim r As Integer, l As Integer, rmv As Integer

Application.ScreenUpdating = False

Set copy_rng = Sheet2.[A1].CurrentRegion
r = copy_rng.Rows.Count

With Sheet1.[A1].CurrentRegion
    .Offset(1).Resize(.Rows.Count - 1, 4).Cells.Clear
End With

With Sheet1
    copy_rng.Offset(1).Resize(r - 1).Copy
    .[A2].Insert Shift:=xlDown
    Application.CutCopyMode = False
    .Range("e2:e" & r) = "=C2*D2"
   
    l = .Range("A55555").End(xlUp).Row

    If l - r > 4 Then
    rmv = l - r - 4
        .Range("A" & r + 1 & ":A" & rmv + r).Rows.EntireRow.Delete xlUp
    End If
End With

Application.ScreenUpdating = True

End Sub