Copying & resizing a range?

[The Code Cage Team]

Good Afternoon,

I have a macro that each time someone clicks the "Insert Summary
Lines"
button I want it to resize the original range. The macro will copy two
lines
in the current range and insert them, right now I can only get the code
to
select the range and not save it, so when you click on the button again
it
reverts back to the old method. Here is my code:

Code:
--------------------
Sub Insert_Rows()
Dim NumRows As Integer
Dim NumColumns As Integer
Dim S As Integer
Dim Summary_Sheet As Range
Dim Sample As Range



NumberofRows = Range("Summary_Sheet").Rows.Count
NumberofColumns = 15
S = 0
Set Sample = Range("Summary_Sheet")
Worksheets("Summary").Activate
Range("First_Cell").Activate
Set Sum_Description = Worksheets("Summary").Columns("C").Rows("7")
Range(Sum_Description.Address).Activate
Range("Summary_Line").Copy
Range("Summary_Line").Insert shift:=xlShiftDown, copyorigin:=True
S = S + 4
Range("Total_Summary").Copy
Range("Total_Summary").Insert shift:=xlShiftDown, copyorigin:=True

Do Until (NumberofRows = NumRows)
If (S > 0) Then
NumRows = NumberofRows + S
NumColumns = NumberofColumns
Range("Summary_Sheet").Resize(Rowsize:=NumRows, ColumnSize:=NumColumns).Select
End If
NumberofRows = NumberofRows + S
Loop
ThisWorkbook.Save
End Sub
--------------------


Any suggestions>


--
The Code Cage Team

Regards,
The Code Cage Team
www.thecodecage.com