resize and copy

[jer]

Dear all
I am trying to get from (an existing table)

Fees Frequency DueDate LDueDate PNoPayments
$50.00 Y 9/30/2006 9/30/2011 4
$150.00 Y 12/31/2006 9/30/2011 4
$200.00 Y 12/31/2006 9/30/2011 4
$175.00 Y 1/31/2006 9/30/2011 4

to

Fees Frequency DueDate LDueDate PNoPayments
$50.00 Y 9/30/2006 9/30/2011 4
$50.00 Y 9/30/2006 9/30/2011 4
$50.00 Y 9/30/2006 9/30/2011 4
$50.00 Y 9/30/2006 9/30/2011 4
$150.00 Y 12/31/2006 9/30/2011 4
$150.00 Y 12/31/2006 9/30/2011 4
$150.00 Y 12/31/2006 9/30/2011 4
$150.00 Y 12/31/2006 9/30/2011 4
$200.00 Y 12/31/2006 9/30/2011 4
$200.00 Y 12/31/2006 9/30/2011 4
$200.00 Y 12/31/2006 9/30/2011 4
$200.00 Y 12/31/2006 9/30/2011 4
$175.00 Y 1/31/2006 9/30/2011 4
$175.00 Y 1/31/2006 9/30/2011 4
$175.00 Y 1/31/2006 9/30/2011 4
$175.00 Y 1/31/2006 9/30/2011 4

with

Dim cell As Range, i As Long
Dim lastrow As Long, sh1 As Worksheet
Set sh1 = ActiveWorkbook.Worksheets("Sample")
lastrow = sh1.Cells(Rows.Count, 1).End(xlUp).Row

For i = lastrow To 1 Step -1

Set cell = sh1.Cells(i, 1)

If cell.Offset(0, 4) > 1 Then

cell.Resize(cell.Offset(0, 4) - 1, 1).EntireRow.Insert

cell.Resize(1, 5).Copy _
cell.Offset(1, 0).Resize(cell.Offset(0, 4) - 1, 5)

End If
Next i

but having trouble with last couple lines of the code, which I
have modified from newgroup contributors.

Any suggestions help would be greatly appreciated

 

[Tom Ogilvy]

Dim cell As Range, i As Long
Dim lastrow As Long, sh1 As Worksheet
Set sh1 = ActiveWorkbook.Worksheets("Sample")
lastrow = sh1.Cells(Rows.Count, 1).End(xlUp).Row

For i = lastrow To 1 Step -1

Set cell = sh1.Cells(i, 1)

If cell.Offset(0, 4) > 1 Then

cell.Offset(1,0).Resize(cell.Offset(0, 4) - 1, 1).EntireRow.Insert

cell.Resize(1, 5).Copy _
cell.Offset(1, 0).Resize(cell.Offset(0, 4) - 1, 5)

End If
Next i

Untested, but I believe that will work.

 

[jer]

Tom
Thank you ... works like a charm