MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Macro to cut and paste

Posted by Mo on November 07, 2001 9:28 AM

Hello, in the 4th column of my spreadsheet, I have numbers. The macro must search the fourth column, if it encounters any number more than 40 it should cut the whole row, and paste it into sheet 3. There are a few rows more than 40, so it should be able to do it more than once. A good example is the macro below, it’s supposed to search the 3rd column, if it encounters “IBT” it cuts it and pastes to sheet 2. However it only does it once, and there are many IBT. I want it to loop or something like that. By the way if you can make the code below loop than fire away. Thanks in advance

On Error Resume Next
Set x = Columns(3).Find("IBT")
If Err.Number = 0 Then
Rows(x.Row).Cut Sheets(2).Range("A65536").End(xlUp).Offset(1)
End If

Posted by Barrie Davidson on November 07, 2001 10:11 AM

Mo, you can try this.

Sub CutPasteRows()
' Written by Barrie Davidson
Dim counter As Long
Dim RowCount As Long

Application.ScreenUpdating = False
RowCount = Range("D65536").End(xlUp).Row
counter = 1
Do Until counter > RowCount
If Range("D" & counter).Value > 40 Then
Range("D" & counter).EntireRow.Cut Destination:=Sheets("Sheet3"). _
Range("D65536").End(xlUp).Offset(1, -3)
Range("D" & counter).EntireRow.Delete
RowCount = RowCount - 1
counter = counter - 1
End If
counter = counter + 1
Application.ScreenUpdating = True
End Sub

BarrieBarrie Davidson

Posted by Mo on November 07, 2001 12:11 PM

Thanks Barrie