title: VBA Excel Automatically Copy & Paste Specific cells based on IF statement
body: <p>The code I have placed below is a combination of what works and what i can't get to work.</p>
  
  <p>The code that is not commented will copy cells to "sheet2" from "sheet1".</p>
  
  <p>What I cannot get to work correctly is the code that I have disabled that would replace my Range Method of coping from "sheet1" to "sheet2".</p>
  
  <p>Also my <code>If Then</code> Code is what will some up what I'm trying to accomplish. I'm trying to get the If statement to search all of column A and copy all Cars that are year 1991 to sheet2. </p>
  
  <p>Mind my poor coding skills I'm Doing my best to show &amp; explain so I can be helped.<br> 
  Here is the Sheets 1 &amp; 2</p>
  
  <p>(hxxp://s15.postimg.org/orfw7tlaz/test.jpg)</p>
  
  <p><strong>OLD CODE</strong></p>
  
  <pre><code>Sub Macro1()
  
  Set a = Sheets("Sheet1")
  Set b = Sheets("Sheet2")
  Set c = Sheets("Sheet3")
  
  Dim x
  Dim z
  Dim lastrow As Long, erow As Long
  
  x = x + 1
  z = 2
  
  
  'lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
  'lastrow = b.Cells(Rows.Count, 1).End(xlUp).Row
  'For i = 2 To lastrow
  lastrow = b.Range("A" &amp; Rows.Count).End(xlUp).Row + x
  
  'If a.Cells(i, 1) = “1991” Then
  
  
  'a.Cells(i, 1).Copy
  'erow = b.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  'b.Paste Destination:=b.Range.Cells(erow, 4)
  Range("A" &amp; z).Copy Destination:=b.Range("D" &amp; lastrow)
  
  'a.Cells(i, 1).Copy
  'b.Paste Destination:=b.Range.Cells(erow, 1)
  Range("B" &amp; z).Copy Destination:=b.Range("A" &amp; lastrow)
  
  
  'a.Cells(i, 1).Copy
  'b.Paste Destination:=b.Range.Cells(erow, 3)
  Range("C" &amp; z).Copy Destination:=b.Range("C" &amp; lastrow)
  
  'a.Cells(i, 1).Copy
  'b.Paste Destination:=b.Range(erow, 2)
  Range("D" &amp; z).Copy Destination:=b.Range("B" &amp; lastrow)
  'End If
  
  'Next i
  Application.CutCopyMode = False
  Sheet2.Columns().AutoFit
  'b.Range("A1").Select
  End Sub
  </code></pre>
  
  <p>So I added some Lines and Began changing the cell locations to reflect the format I need and now when I run the macro it only copys the very last line from Sheet1 to sheet2. I believe it has to do with the order of the way these cells are. </p>
  
  <pre><code>        b.Cells(erow, 1) = a.Cells(i, 1)
          b.Cells(erow, 2) = a.Cells(i, 2)
          b.Cells(erow, 3) = a.Cells(i, 3)
          b.Cells(erow, 4) = a.Cells(i, 4)
  </code></pre>
  
  <p>Changing these back fixes it so it copys all the cells but its not what I'm trying to do.
  The Code I'm Trying to run is Below</p>
  
  <p><strong>NEW CODE Working Thanks to EntryLevel!</strong></p>
  
  <pre><code>Sub TakeTwo()
      Dim a As Worksheet
      Dim b As Worksheet
      Dim c As Worksheet
  
      Set a = ThisWorkbook.Sheets("Sheet1")
      Set b = ThisWorkbook.Sheets("Sheet2")
      Set c = ThisWorkbook.Sheets("Sheet3")
  
      Dim i As Long
      Dim lastrowsheet1 As Long
      Dim erow As Long
  
      lastrowsheet1 = a.Cells(Rows.Count, 1).End(xlUp).Row
      erow = b.Cells(b.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      For i = 2 To lastrowsheet1
          If a.Cells(i, 1).Value = "AEM" Then
              b.Cells(erow, 31) = a.Cells(i, 1)  '&lt;------When I modify these
              b.Cells(erow, 6) = a.Cells(i, 4)   '&lt;------The copied cells
              b.Cells(erow, 28) = a.Cells(i, 5)  '&lt;------Don't show up
              b.Cells(erow, 26) = a.Cells(i, 6)  '&lt;------In Sheet2
              b.Cells(erow, 46) = a.Cells(i, 11) '&lt;------Only the last
              b.Cells(erow, 29) = a.Cells(i, 14) '&lt;------Line found Is copied to sheet2
              erow = erow + 1
          End If
      Next i
      Application.CutCopyMode = False
      b.Columns.AutoFit
      'b.Range("A1").Select
  End Sub
  </code></pre>
  
  <p><strong>Now Using Same Working Code</strong> But <strong>Different function Not Working</strong></p>
  
  <pre><code>Sub TakeThree()
      Dim a As Worksheet
      Dim b As Worksheet
      Dim c As Worksheet
  
      Set a = ThisWorkbook.Sheets("Sheet1")
      Set b = ThisWorkbook.Sheets("Sheet2")
      Set c = ThisWorkbook.Sheets("Sheet3")
  
      Dim i As Long
      Dim lastrowsheet1 As Long
      Dim erow As Long
  
      lastrowsheet1 = c.Cells(Rows.Count, 1).End(xlUp).Row
      erow = b.Cells(b.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      For i = 2 To lastrowsheet1
          If c.Cells(i, 1).Value = b.Cells(erow, 6).Value Then 'If serial number is found from sheet2 column 6 in sheet3 Column 1
              b.Cells(erow, 8) = c.Cells(i, 2) 'Then copy description from sheet3 cell row to Sheet2 cell row
              erow = erow + 1
              End If
      Next i
      Application.CutCopyMode = False
      b.Columns.AutoFit
      c.Columns.AutoFit
      'b.Range("A1").Select
  End Sub
  </code></pre>
  
  <p>So I added another For Loop with Dim r and added another Line erow = erow + r &amp; now the code copys the first 2 rows needed but does not continue iterating down the list. which is confusing me. here is the code below i have added.</p>
  
  <pre><code>Dim r As Long
  Dim i As Long
  Dim lastrowsheet1 As Long
  Dim erow As Long
  
  lastrowsheet1 = c.Cells(Rows.Count, 1).End(xlUp).Row
  erow = b.Cells(b.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
   For r = 1 To erow
    For i = 2 To lastrowsheet1
    If c.Cells(i, 1) = b.Cells(erow, 6) Then
       b.Cells(erow, 8) = c.Cells(i, 2)
       erow = erow + r
    End If
  Debug.Print i
    Next i
    Next r
  </code></pre>