Have a look if it suits you better?
Sub test2()
Dim i As Long, last as long
i = val(InputBox("which row shall we start?"))
last = val(InputBox("which row shall we finish?"))
Application.ScreenUpdating = False
Do
If Cells(i, Columns.Count).End(xlToLeft).Column > 4 Then
Rows(i + 1).Insert
Range(Cells(i, "E"), Cells(i, Columns.Count).End(xlToLeft)).Cut Cells(i + 1, "B")
last = last +1
End If
i = i + 1
Loop Until Cells(i, "B") = "" or i > last
End Sub
or (if you want to have it copied to second sheet):
Sub test3()
Dim i As Long, last As Long, j As Long
i = Sheets("sheet2").Cells(Rows.Count, "B").End(xlUp).Row + 1
j = Val(InputBox("which row shall we start?"))
last = Val(InputBox("which row shall we finish?"))
Application.ScreenUpdating = False
Sheets("Sheet1").Rows(j & ":" & last).Copy Sheets("sheet2").Cells(i, "A")
Sheets("sheet2").Activate
last = last + i - j
Do
If Cells(i, Columns.Count).End(xlToLeft).Column > 4 Then
Rows(i + 1).Insert
Range(Cells(i, "E"), Cells(i, Columns.Count).End(xlToLeft)).Cut Cells(i + 1, "B")
last = last + 1
End If
i = i + 1
Loop Until Cells(i, "B") = "" Or i > last
Application.CutCopyMode = False
End Sub
Bookmarks