複数のセルをコピーして貼り付けるVBA基準を満たしている場合

Question

ループを使用しているセルのすぐ隣にある条件を満たす場合、セルを移動する方法は？ は<（レン= 43）の基準があると言う - 私はそれに2列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  | 

は右隣に列を以下の右の列です。どのようにループとlenでそれを使用するには？よりよいアプローチは何ですか？ありがとう、歓声！その列にMアカウンティング＃は保存され、次のセルの右隣に私がオフセットする必要があるが、私が持っている上記のコードとされているだけで削除され

更新

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 

値は列Nで、そのすぐ隣のセルは移動しません。

Answer 1

あなたは1次（コメント）のようにコードを変更することもできます。

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