title: Cut and paste a range of cells to a select destination
body: <p>I want to cut and paste a range of cells (ex. A2:D2 to B1:E1) and then repeat this process for 692 rows.</p>
  
  <p><a href="https://i.stack.imgur.com/e9PVq.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/e9PVq.png" alt="enter image description here"></a></p>
  
  <p>I have been trying to do this in macros however have been unsuccessful.</p>
  
  <pre><code>Sub cut_paste() 
      Dim nr As Integer 
      For nr = 1 To 692 
          Range("A" &amp; nr).Select 
          Selection.Cut 
          Range("B" &amp; nr).Select 
          ActiveSheet.Paste 
          Range("B" &amp; nr).Select 
          Selection.Cut 
          Range("C" &amp; nr).Select 
          ActiveSheet.Paste 
          Range("C" &amp; nr).Select 
          Selection.Cut 
          Range("D" &amp; nr).Select 
          ActiveSheet.Paste 
          Range("D" &amp; nr).Select 
          Selection.Cut 
          Range("E" &amp; nr).Select 
          ActiveSheet.Paste 
      Next nr 
  End Sub
  </code></pre>
  
  <blockquote>
    <p>ERROR 4001</p>
  </blockquote>
  
  <p><a href="https://i.stack.imgur.com/f06Hc.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/f06Hc.png" alt="enter image description here"></a></p>
  
  <p><a href="https://i.stack.imgur.com/IuZRd.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/IuZRd.png" alt="enter image description here"></a></p>