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
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