Добавление новых строк на основе заголовка столбца с использованием VBA

Я работаю над двумя листами Excel, которые имеют общие поля. Мне нужно будет вставить данные в sheet2 на основе заголовка столбца и ниже существующих данных с помощью VBA. Например:

Таблица 1:

ID Name Custcode CustName 1 Aryan 0020 Aryan Ent 2 SUman 0030 Suman Ent 3 Ramesh 0040 Ramesh Ent 

Таблица 2:

 ID Name Alias Name Custcode CustName Prodcode Proddesc 1 Aryan Alex 0020 Aryan Ent xx001 Books 2 SUman Sandy 0030 Suman Ent xx002 online 

Целевая таблица:

 ID Name Alias Name Custcode CustName Prodcode Proddesc 1 Aryan Alex 0020 Aryan Ent xx001 Books 2 SUman Sandy 0030 Suman Ent xx002 online 3 Ramesh 0040 Ramesh Ent 

Я нашел приведенный ниже код в Интернете, но мне нужна настройка для этого. Он вставляет весь столбец и не добавляет новые строки:

 Sub copycolumns() Dim i As Integer, searchedcolumn As Integer, searchheader As Object For i = 1 To 83 Set searchheader = Sheets("Temp").Cells(1, i) searchedcolumn = 0 On Error Resume Next searchedcolumn = Sheets("Malaysia Live data").Rows(1).Find(what:=searchheader.Value, lookat:=xlWhole).Column On Error GoTo 0 If searchedcolumn <> 0 Then Sheets("Malaysia Live data").Columns(searchedcolumn).Copy Destination:=searchheader End If Next i End Sub 

 Sub test_1() Dim a As Variant Dim b As Variant a = 2 Worksheets("Target Table").Activate While Worksheets("Table 1").Cells(a, 1) <> vbNullString Cells(a, 1) = Worksheets("Table 1").Cells(a, 1) Cells(a, 2) = Worksheets("Table 1").Cells(a, 2) Cells(a, 5) = Worksheets("Table 1").Cells(a, 3) Cells(a, 6) = Worksheets("Table 1").Cells(a, 4) b = WorksheetFunction.Match(Cells(a, 2), Worksheets("Table 2").Range("B:B")) If Not IsError(b) Then Cells(a, 3) = Worksheets("Table 2").Cells(b, 3) Cells(a, 8) = Worksheets("Table 2").Cells(b, 8) Cells(a, 7) = Worksheets("Table 2").Cells(b, 7) End If b = vbNullString a = a + 1 Wend End Sub