title: Why is my Excel VBA code to copy a cell so slow?
body: <p>I have 2 worksheets in the same workbook. If a cell in SourceSheet meets certain criteria, I want to copy several non-adjacent cells in the same row to NewSheet. The problem is that it's taking over a half second to paste each and every cell, making the macro far too slow. The code below takes 8 seconds to complete a single loop. Is there a faster way I could do this?</p>
  
  <pre><code>Dim EnrollmentChanges As Range
  Dim course1 As Range
  Dim course1status As Range
  Dim row As Long
  Dim lrow As Long
  Dim NewSheetRow As Long
  
  'This is a dynamic named range
  Set EnrollmentChanges = Sheets("SourceSheet").Range("Source")
  NewSheetRow = 0
  lrow = Sheets("SourceSheet").Range("A1").End(xlDown).row
  
  For row = 2 To lrow
  
  With EnrollmentChanges
  
      course1 = Sheets("SourceSheet").Range("A" &amp; row)
  
      If course1 &lt;&gt; "" Then
          course1status = Sheets("SourceSheet").Range("BS" &amp; row)
          If InStr(1, course1, "APEX") And course1status = "1" Then
              NewSheetRow = NewSheetRow + 1
              Sheets("NewSheet").Range("A" &amp; NewSheetRow) = NewSheetRow
              Sheets("NewSheet").Range("B" &amp; NewSheetRow) = "W"
              Sheets("NewSheet").Range("C" &amp; NewSheetRow) = "S"
              Sheets("NewSheet").Range("D" &amp; NewSheetRow) = "MySchool"
              Sheets("SourceSheet").Range("B" &amp; row).Copy Sheets("NewSheet").Range("G" &amp; NewSheetRow)
              Sheets("SourceSheet").Range("W" &amp; row).Copy Sheets("NewSheet").Range("H" &amp; NewSheetRow)
              Sheets("SourceSheet").Range("V" &amp; row).Copy Sheets("NewSheet").Range("J" &amp; NewSheetRow)
              Sheets("SourceSheet").Range("Y" &amp; row).Copy Sheets("NewSheet").Range("K" &amp; NewSheetRow)
              Sheets("NewSheet").Range("L" &amp; NewSheetRow) = "OR"
              Sheets("SourceSheet").Range("B" &amp; row).Copy Sheets("NewSheet").Range("M" &amp; NewSheetRow)
              Sheets("SourceSheet").Range("A" &amp; row).Copy Sheets("NewSheet").Range("P" &amp; NewSheetRow)
          End If
  
      Else: GoTo NextRow
      End If 
  End With
  NextRow:
  Next
  </code></pre>