Andropov
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
Разработка VBA макросы Excel, Word на
заказ.
Сказать спасибо на
Юмани