Sub CopyData()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim searchValue As String
    Dim searchRange As Range, copyRange As Range
    Dim lastRow As Long, curCol As Long
    Dim iCount As Long, j As Long
    
    'Имена листов вводите свои
    Set ws1 = ActiveWorkbook.Worksheets("Лист1")
    Set ws2 = ActiveWorkbook.Worksheets("Лист2")

    searchValue = "Замена разъёма" 'Можно так, а можно
    'iValue = InputBox("Введите заголовок")
    

    Set searchRange = ws1.Rows(1).Find(searchValue, LookIn:=xlValues, LookAt:=xlWhole)

    If searchRange Is Nothing Then
        MsgBox "Ячейка с текстом """ & searchValue & """ не найдена на листе ""Лист1""."
        Exit Sub
    End If

    lastRow = ws1.Cells(ws1.Rows.Count, searchRange.Column).End(xlUp).Row
    curCol = searchRange.Column
    
    Set copyRange = ws1.Range(ws1.Cells(2, curCol), ws1.Cells(lastRow, curCol))
    
    iRowNumber = InputBox("Введите номер строки, куда копировать") 'Это номер строки на листе2
    
    'Этот код используется в том случае, если столбец, в который попадут данные - ниже не пустой,
    'Если пустой, то можно просто скопировать и повернуть
    iCount = copyRange.Rows.Count - 1

        For j = 1 To iCount
            ws2.Cells(iRowNumber, j).Value = copyRange.Cells(j, 1).Value
        Next j

End Sub