Hi there,

The fundamental problem occurs in the following line:


    Set z2 = Sheets("Sheet1").Range("E2:E15").End(xlDown)
The equivalent line for z1 works because there are no blank cells in the range, but new rows will have been inserted before the above line of code is executed, and therefore z2 will refer to the cell immediately above the first newly-inserted row, rather than the last non-blank cell in the column.


Try the following routine and see if it does what you want:




Sub pins()

    Const sTEST_COLUMN  As String = "E"
    Const sTEST_VALUE   As String = "112"
    Const sSHEET_NAME   As String = "Sheet1"
    Const iSTART_ROW    As Integer = 2

    Dim rTestCell       As Range
    Dim rLastCell       As Range
    Dim wks             As Worksheet

    Set wks = Worksheets(sSHEET_NAME)

    Set rLastCell = wks.Range(sTEST_COLUMN & iSTART_ROW).End(xlDown)

    Set rTestCell = rLastCell

    Do Until rTestCell.Row = iSTART_ROW

        If rTestCell.Value = sTEST_VALUE Then
            rTestCell.EntireRow.Offset(1, 0).Insert
        End If

        Set rTestCell = rTestCell.Offset(-1, 0)

    Loop

    Set rTestCell = rLastCell  '   The location of rLastCell is automatically updated as new rows are inserted

    Do Until rTestCell.Row = iSTART_ROW

        If rTestCell.Value = sTEST_VALUE Then
            rTestCell.EntireRow.SpecialCells(xlCellTypeVisible).Copy
            wks.Paste Destination:=rTestCell.EntireRow.Offset(1, 0)
        End If

        Set rTestCell = rTestCell.Offset(-1, 0)

    Loop

End Sub

Defining the various parameters as Const(ants) keeps them in a convenient location in case they ever need to be changed in response to changes in worksheet layout etc.


Hope this helps - please let me know how you get on.

Regards,

Greg M