With Workbooks("Источник1").Worksheets("1")

Option Explicit

Sub Автофигура2_Щелкнуть()
Dim iLastRow As Long
With Workbooks("Источник1").Worksheets("1")
.UsedRange.Copy Range("A2")
End With
With Workbooks("Источник2").Worksheets("TDSheet")
iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("B11:B" & iLastRow).Copy Range("I3")
.Range("A11:A" & iLastRow).Copy Range("L3")
End With
End Sub

With Workbooks("Источник1").Worksheets(1)

Option Explicit

Sub tt()
    Dim r1 As Range, r2 As Range, wb As Workbook, c As Range
    Dim t$, i&

    Application.ScreenUpdating = False

    Set r1 = Workbooks("6665066.xlsx").Sheets(1).[a1].CurrentRegion
    Set r2 = Workbooks("9581531.xlsx").Sheets(1).[a8].CurrentRegion
    Set wb = Workbooks.Add(1)

    With CreateObject("scripting.dictionary"): .comparemode = 1
        For Each c In r1.Columns(9).Cells
            .Item(c.Text & "|" & c.Offset(, 3).Text) = c.Row
        Next
        For Each c In r2.Columns(1).Cells
            t = c.Offset(, 1).Text & "|" & c.Text
            If .exists(t) Then
                i = i + 1
                r1.Rows(.Item(t)).Copy wb.Sheets(1).Cells(i, 1)
                c.Resize(, 7).Copy wb.Sheets(1).Cells(i, 17)
            End If
        Next
    End With

    wb.Sheets(1).UsedRange.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub