如果符合条件，则VBA可复制和粘贴多个单元格

Question

how to move cells if criteria is met following also the cells right next to it using loop? say the criteria is (Len=43) <- Acct#

Column#  |Date     |  Country   |  Acct#   |   Fruit     |   Price   |  Qty  
1        |11/02/16 |  India     |  5002xxx |   apple     |   $9      |   5  
2        |12/02/16 |  5001xxx   |  Orange  |   $8        |   10      |

I need to move the column 2 acct# to it's right column following the columns right next to it. how to use it with loop and len? what is the better approach? Thanks and cheers!

Update

 Sub Findandcut2()
    Dim row As Long

    For row = 2 To 1000

        If Range("M" & row).Value Like "*5027.1227000.0000.0000.000.0000.0000.0000*" Then

            Range("N" & row).Value = Range("M" & row).Value
            Range("M" & row).Value = ""
        End If
    Next

End Sub

so in Column M is where the Acct# is stored and the following cells right next to it I have to offset but with the code above I've got is just deleting the value is Column N and the cells right next to it is not moving.

Answer 1

you may want to change your code like the (commented) following one:

Sub Findandcut2()
    Dim cell As Range

    For Each cell In Range("M2", Cells(Rows.Count, "M").End(xlUp)) '<--| loop through all column "M" cell from row 2 down to last not empty row
        If cell.Value Like "*5027.1227000.0000.0000.000.0000.0000.0000*" Then
            With Range(cell, cell.End(xlToRight)) '<--| reference the range from current column M cell rightwards till the one preceeding first not empty one
                .Offset(, 1).Value = .Value '<--| copy values
            End With
            cell.ClearContents '<--| need to clear the cell you started offset values from?
        End If

    Next cell
End Sub