Hi Dave,

Try this minor amendment:

'=============>>
Public Sub TesterX()
   Dim WB As Workbook
   Dim SH As Worksheet
   Dim rng As Range
   Dim i As Long, k As Long
   Dim LRow As Long

   Set WB = Workbooks("YourBook.xls")     '<<==== CHANGE
   Set SH = WB.Sheets("Sheet1")                   '<<==== CHANGE

   LRow = SH.Cells(Rows.Count, "A").End(xlUp).Row

   For i = LRow To 1 Step -1
       With SH.Cells(i, "A")
           k = .Value - 1
           If k > 0 Then
               .EntireRow.Resize(k).Insert
               .Offset(-k, 1).Resize(k).Value = _
               .Offset(0, 1).Value
               .Offset(-k).Resize(k).Value = .Value
           End If
       End With
   Next i

End Sub
'<<=============

---
Regards,
Norman

FYI
I found another script in this newsgroup which fundamently does what I
want.
exept it copies N+1 times instead of N. I can overide this with a crude
edit before I run the macro until I work out a better way.

Sub AddRows()
Dim i As Long, AdditionalRows As Long, NextRow As Long
Dim Cel As Range

For Each Cel In ActiveSheet.Range("A1").EntireColumn.Cells
   If Cel.Value = "" Then
       Exit For
   Else
       If IsNumeric(Cel.Value) Then
           AdditionalRows = AdditionalRows + CLng(Cel.Value) + 3
       End If
   End If
Next Cel

If ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row +
AdditionalRows < 65537 Then
   For Each Cel In ActiveSheet.Range("A1").EntireColumn.Cells
       If NextRow > 0 Then
           NextRow = NextRow - 1
           GoTo NextCel
       End If

       NextRow = 0
       If Cel.Value <> "" And IsNumeric(Cel.Value) Then
           For i = 1 To CLng(Cel.Value)
               Cel.Offset(1, 0).EntireRow.Insert
               Cel.EntireRow.Copy Cel.Offset(1, 0)
           Next i
           NextRow = NextRow + i - 1
       End If
NextCel:
   Next Cel
Else
   End