copy and paste data with conditions based on sorted column in vba

Question

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.

Private Sub Button1_Click()

'Declaration of variable lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

' 1. Define constants.

' Source
Const sName As String = "Sheet1"
Const sCol As String = "a"
Const sfRow As Long = 2
' Destination
Const dName As String = "Sheet2"
Const dCol As String = "b"
Const dfRow As Long = 3
' Other
Const Msg As String = "Copied column sorted."

' 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 "a's" in Sheet 1, Column A and pastes in Sheet 2, Column B
    If Worksheets("Sheet1").Range("A" & i).Value = "H" Then
        Worksheets("Sheet1").Range("B" & i).Copy
        
        Worksheets("Sheet2").Activate
        lastrow2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
        
        Worksheets("Sheet2").Range("E" & i + 1).Select
                    
        ActiveSheet.Paste

    'Conditional if statement that copies "a's" in Sheet 1, Column A and pastes in Sheet 2, Column B
    Else
        Worksheets("Sheet1").Range("A" & i).Value = "H/R"
        Worksheets("Sheet1").Range("B" & i).Copy
        
        Worksheets("Sheet2").Activate
        lastrow2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
        
        Worksheets("Sheet2").Range("E" & i + 1).Select
                    
        ActiveSheet.Paste
    
    'Conditional if statement that copies "a's" in Sheet 1, Column A and pastes in Sheet 2, Column B
    Else
        Worksheets("Sheet1").Range("A" & i).Value = "H/R/I"
        Worksheets("Sheet1").Range("B" & i).Copy
        
        Worksheets("Sheet2").Activate
        lastrow2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
        
        Worksheets("Sheet2").Range("E" & i + 1).Select
                    
        ActiveSheet.Paste
    
    'Deletes empty cells and shifts "a's" upward
    Else
        Worksheets("Sheet2").Range("E" & i).Value = ""
        Columns("E:E").Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.Delete Shift:=xlUp
        
    End If
  
Next i

End Sub

Answer 1

Copy Column Sorted

Step By Step

Private Sub Button1_Click()
    
    ' 1. Define constants.
    
    ' Source
    Const sName As String = "Sheet1"
    Const sCol As String = "A"
    Const sfRow As Long = 2
    ' Destination
    Const dName As String = "Sheet2"
    Const dCol As String = "B"
    Const dfRow As Long = 3
    ' Other
    Const Msg As String = "Copied column sorted."
    
    ' 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
    
End Sub