title: copy and paste data with conditions based on sorted column in vba
body: <p>so the code that one user gave me works to perfection. I now have a new problem. Brief run down: In Sheet1, ColumnA, Row 2 - the values are copied and pasted, then sorted alphabetically into Sheet2, ColumnB, Row 3. The code below reflects this. My next problem is that I want Sheet 1, ColumnB, Row2 to paste into Sheet2, ColumnE, Row3 based on the conditions within Sheet1, ColumnA. The images below hopefully helps. Each name is next to a category (H, H/R, H/R/I). When I paste into the new sheet, these categories are sorted alphabetically and I want the names to still match their categories (NOT BE SORTED) if that makes sense. Hopefully each image below helps visualize what I'm trying to do. The 1st image is what I start with and the 2nd is what I want the result to be. Please help.</p>
  <p><a href="https://i.stack.imgur.com/T628Q.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/T628Q.png" alt="Excel Columns 1" /></a></p>
  <p><a href="https://i.stack.imgur.com/AdQyY.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/AdQyY.png" alt="Excel Columns 2" /></a></p>
  <p>Private Sub Button1_Click()</p>
  <p>'Declaration of variable
  lastrow = Worksheets(&quot;Sheet1&quot;).Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row</p>
  <pre><code>' 1. Define constants.
  
  ' Source
  Const sName As String = &quot;Sheet1&quot;
  Const sCol As String = &quot;a&quot;
  Const sfRow As Long = 2
  ' Destination
  Const dName As String = &quot;Sheet2&quot;
  Const dCol As String = &quot;b&quot;
  Const dfRow As Long = 3
  ' Other
  Const Msg As String = &quot;Copied column sorted.&quot;
  
  ' 2. Reference the workbook ('wb')
  Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
  
  ' 3. Reference the source range ('srg').
  
  ' Reference the source worksheet ('sws').
  Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
  ' Reference the source first cell ('sfCell').
  Dim sfCell As Range: Set sfCell = sws.Cells(sfRow, sCol)
  ' Using '.End(xlUp)', reference the source last cell ('slCell').
  Dim slCell As Range: Set slCell = sws.Cells(sws.Rows.Count, sCol).End(xlUp)
  ' Using the source first and last cells, reference the source range.
  Dim srg As Range: Set srg = sws.Range(sfCell, slCell)
  
  ' 4. Reference the destination range ('drg').
  
  ' Reference the destination worksheet ('dws').
  Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
  ' Reference the destination first cell ('dfCell')..
  Dim dfCell As Range: Set dfCell = dws.Cells(dfRow, dCol)
  ' Using '.Resize' and the number of rows of the source range
  ' ('srg.rows.count') on the destination first cell,
  ' make the destination range the same size as the source range.
  Dim drg As Range: Set drg = dfCell.Resize(srg.Rows.Count)
  
  ' 5. Copy the values from the source range to the destination range.
  ' This is the most efficient way to copy values and is called
  ' 'Copying by Assignment'.
  drg.Value = srg.Value
  
  ' 6. Sort the destination range.
  drg.Sort drg, xlAscending, , , , , , xlNo
  
  ' 7. Inform so you don't have to worry if you have clicked the button.
  MsgBox Msg, vbInformation
  
  For i = 2 To lastrow
  
      'Conditional if statement that copies &quot;a's&quot; in Sheet 1, Column A and pastes in Sheet 2, Column B
      If Worksheets(&quot;Sheet1&quot;).Range(&quot;A&quot; &amp; i).Value = &quot;H&quot; Then
          Worksheets(&quot;Sheet1&quot;).Range(&quot;B&quot; &amp; i).Copy
          
          Worksheets(&quot;Sheet2&quot;).Activate
          lastrow2 = Worksheets(&quot;Sheet2&quot;).Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row
          
          Worksheets(&quot;Sheet2&quot;).Range(&quot;E&quot; &amp; i + 1).Select
                      
          ActiveSheet.Paste
  
      'Conditional if statement that copies &quot;a's&quot; in Sheet 1, Column A and pastes in Sheet 2, Column B
      Else
          Worksheets(&quot;Sheet1&quot;).Range(&quot;A&quot; &amp; i).Value = &quot;H/R&quot;
          Worksheets(&quot;Sheet1&quot;).Range(&quot;B&quot; &amp; i).Copy
          
          Worksheets(&quot;Sheet2&quot;).Activate
          lastrow2 = Worksheets(&quot;Sheet2&quot;).Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row
          
          Worksheets(&quot;Sheet2&quot;).Range(&quot;E&quot; &amp; i + 1).Select
                      
          ActiveSheet.Paste
      
      'Conditional if statement that copies &quot;a's&quot; in Sheet 1, Column A and pastes in Sheet 2, Column B
      Else
          Worksheets(&quot;Sheet1&quot;).Range(&quot;A&quot; &amp; i).Value = &quot;H/R/I&quot;
          Worksheets(&quot;Sheet1&quot;).Range(&quot;B&quot; &amp; i).Copy
          
          Worksheets(&quot;Sheet2&quot;).Activate
          lastrow2 = Worksheets(&quot;Sheet2&quot;).Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row
          
          Worksheets(&quot;Sheet2&quot;).Range(&quot;E&quot; &amp; i + 1).Select
                      
          ActiveSheet.Paste
      
      'Deletes empty cells and shifts &quot;a's&quot; upward
      Else
          Worksheets(&quot;Sheet2&quot;).Range(&quot;E&quot; &amp; i).Value = &quot;&quot;
          Columns(&quot;E:E&quot;).Select
          Selection.SpecialCells(xlCellTypeBlanks).Select
          Selection.Delete Shift:=xlUp
          
      End If
    
  Next i
  </code></pre>
  <p>End Sub</p>