'вводные данные из книг
    Const name1 = "имя книги1.xlsx"
    Const name2 = "имя книги2.xlsx"
 
'задаем переменные  
    Sub BookBook()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
 
'выводим сообщение об ошибке, если не найдена книга name1/name2      
    On Error Resume Next
    Set wb1 = Workbooks(name1)
    Set wb2 = Workbooks(name2)
    On Error GoTo 0
    If wb1 Is Nothing Then
        MsgBox "File not found " & name1, vbExclamation
        Exit Sub
    End If
    If wb2 Is Nothing Then
        MsgBox "File not found " & name2, vbExclamation
        Exit Sub
    End If
 
'тут уже туго соображаю.. делаем массив вроде как, и обработка данных покнижно в таблице 1 (sheets(1))     
    Dim y As Long
    Dim u As Long
    Dim dicY As Object
    Set dicY = CreateObject("Scripting.Dictionary")
    Dim ar1 As Variant
    Dim ar2 As Variant
    With wb1.Sheets(1)
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        ar1 = .Range(.Cells(1, 1), .Cells(y, [P1].Column))
    End With
    With wb2.Sheets(1)
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        ar2 = .Range(.Cells(1, 1), .Cells(y, [P1].Column))
    End With
    
'обозначаем столбцы из книги 1, которые оставить пустыми
    For y = 2 To UBound(ar1, 1)
        dicY.Item(CStr(ar1(y, 1))) = y
        ar1(y, 3) = Empty
        ar1(y, 10) = Empty
        ar1(y, 11) = Empty
        ar1(y, 12) = Empty
   ar1(y, 15) = Empty
    Next
    
 'заполняем пустые столбцы данными из таблицы 2(иначе говоря заменяем данные в столбцах на нужные нам из табл.2)
    For y = 2 To UBound(ar2, 1)
        If dicY.Exists(CStr(ar2(y, 1))) Then
            u = dicY.Item(CStr(ar2(y, 1)))
            ar1(u, 3) = ar2(y, 12)
            ar1(u, 10) = ar2(y, 9)
       ar1(u, 11) = ar2(y, 8)
            ar1(u, 12) = ar2(y, 14)
            ar1(u, 15) = ar2(y, 13)         
        End If
    Next
 
'создаем книгу 3 и переносим туда наши данные       
    Dim wb3 As Workbook
    Set wb3 = Workbooks.Add(1)
    wb3.Sheets(1).Cells(1, 1).Resize(UBound(ar1, 1), UBound(ar1, 2)) = ar1
End Sub