Copy rows of data to another sheet in Excel and add column VBA

Question

I can't get my head around this.

I have a data structure like this:

I would like to end up with something like this (in another sheet).

If column E is equivalent to 2, then the row should be copied to the other sheet, and the row with the same ID (Column A) the name in that row should be inserted in the final row.

Actually, I'm trying to merge/combine 2 rows, as seen in the picture, such that each ID number is only represented once in Sheet2.

Sub Test()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Sheet1")
    Dim i As Integer
    Dim last_row As Integer
    last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
    For i = 2 To last_row
        If sh.Range("D" & i).Value = 2 Then
            sh.Range("A1:G3").Copy _
            Worksheets("sheet2").Range("A1")
        End If
    Next i
End Sub

For now, I can only copy a range. And then I'm confused by which order to do the subtasks.

Answer 1

This is using a dictionary to make sure you don't copy multiples of the same id.

I'm assuming based on your example you always want the first instance of each id.

    Dim sourcesh As Worksheet
    Dim destsh As Worksheet
    
    Set sourcesh = ThisWorkbook.Sheets("Sheet1")
    Set destsh = ThisWorkbook.Sheets("Sheet2")
    
    Dim i As Long
    Dim j As Long
    Dim lr As Long
    
    With sourcesh
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim dict As Object
        Set dict = CreateObject("Scripting.Dictionary")
        j = 1
        For i = 2 To lr
            If .Cells(i, 4).Value = 2 Then
                If Not dict.exists(.Cells(i, 1).Value) Then
                    destsh.Cells(j, 1) = .Cells(i, 1)
                    destsh.Cells(j, 2) = .Cells(i, 2)
                    destsh.Cells(j, 4) = .Cells(i, 3)
                    destsh.Cells(j, 5) = .Cells(i, 4)
                    destsh.Cells(j, 6) = .Cells(i, 5)
                    destsh.Cells(j, 7) = .Cells(i, 6)
                    destsh.Cells(j, 8) = .Cells(i, 7)
                    
                    dict.Add .Cells(i, 1).Value, j
                    j = j + 1
                Else
                    destsh.Cells(dict(.Cells(i, 1).Value), 3) = .Cells(i, 2)
                End If
            End If
        Next i
    End With