Hi Esrei,

Try:

'===================
Public Sub Deilv2()
Dim LastRow As Long
Dim row_index As Long
Dim rng As Range

Set rng = Range("B2:K25")

Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "b").End(xlUp).Row
For row_index = LastRow - 1 To 26 Step -1
If Cells(row_index, "B").Value < _
Cells(row_index + 1, "B").Value Then
Cells(row_index + 1, "B").Resize(26).EntireRow. _
Insert Shift:=xlDown
rng.Copy Destination:=Cells(row_index + 1, "B").Offset(1)
End If
Next
Application.ScreenUpdating = True
End Sub
'<<===================


---
Regards,
Norman



"Esrei" wrote in message
...
Thanks it works like a charm.
Now one step more
I want to copy range B2:K25 and insert it ont the 2nd row of the 26 that
was
just inserted by the first part of the macro.
Thanks
"Norman Jones" wrote:

Hi Esrei,

Try:

Sub Deilv()
Dim LastRow As Long
Dim row_index As Long

Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "b").End(xlUp).Row
For row_index = LastRow - 1 To 26 Step -1
If Cells(row_index, "B").Value < _
Cells(row_index + 1, "B").Value Then
Cells(row_index + 1, "B").Resize(26).EntireRow. _
Insert Shift:=xlDown
End If
Next
Application.ScreenUpdating = True
End Sub


---
Regards,
Norman



"Esrei" wrote in message
...
This is my macro to insert lines if the value in b chanbes. I want it
to
inset 26 lines it only inserts 1 please help

Sub Deilv()
Dim LastRow As Long
Dim row_index As Long
Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "b").End(xlUp).Row
For row_index = LastRow - 1 To 26 Step -1
If Cells(row_index, "B").Value < _
Cells(row_index + 1, "B").Value Then
Cells(row_index + 1, "B").EntireRow.insert _
(x24ShiftDown)
End If
Next
End Sub