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, its 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
Mo
On Error Resume Next
Err.Clear
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
Loop
Application.ScreenUpdating = True
End Sub
Regards,
BarrieBarrie Davidson
Posted by Mo on November 07, 2001 12:11 PM
Thanks Barrie
