Insert new row with above active cell using vba excel

[Iarianna81]

Hi ,

i have data in column A, B ,C but i need to insert new row above active cell in coloum B

original format

A	B	C
4	APPLE
		SUGAR
		MILK
		WATER
5	BANANA
		SUGAR
		MILK
		WATER
10	MANGGO
		SUGAR
		MILK
		WATER

<colgroup><col><col><col></colgroup><tbody>
</tbody>

I found some macro using below code
Sub InsertRows()


Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Range("B3", Range("B" & Rows.Count).End(xlUp))

.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents
.Offset(, -1).EntireColumn.Delete
.EntireColumn.RemoveSubtotal

End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



below data after i run this code...row insert below active cell...not above cell

A	B	C
4	APPLE
		SUGAR
		MILK
		WATER
5	BANANA
		SUGAR
		MILK
		WATER
10	MANGGO
		SUGAR
		MILK
		WATER

<colgroup><col><col><col></colgroup><tbody>
</tbody>

what i need is

A	B	C
4	APPLE
		SUGAR
		MILK
		WATER
5	BANANA
		SUGAR
		MILK
		WATER
10	MANGGO
		SUGAR
		MILK
		WATER

<colgroup><col><col><col></colgroup><tbody>
</tbody>

Thanks for your advance
***Kt***