Поиск строки в строке с помощью поля ввода копирует выбранные ячейки из этой строки и вставляет их в новый лист

Question

Я надеюсь выполнить следующие шаги в одном скрипте:

Принять пользовательский ввод через поле ввода.Найдите в этом листе («Лист 3») этот текст.Скопируйте 5 ячеек B7, D7, F7, G7, I7 из этой поисковой ячейки и вставьте их затем в рабочую таблицу («Лист2») в ячейках B2, C2, D2, E2, F2

. Это мой код.

    Dim rId As Range, celS As Range, celT As Range
Dim wS As Worksheet, wT As Worksheet
Dim sId As String

Set wS = Worksheets("Sheet3")
Set wT = Worksheets("Sheet2")
Set celT = wT.Range("B2")

    sId = InputBox("Enter ID")
    If Len(sId) = 0 Then Exit Sub

    Set rId = wS.Range("A2:BM2210") 'start of search area
    Set rId = wS.Range(rId, wS.Cells(wS.Rows.Count, rId.Column).End(xlUp)) 'rest of data

    Set celS = rId.Find(sId, , xlValues, xlWhole, , , False)

    If Not celS Is Nothing Then
        Set celS = Intersect(wS.Columns("A:B"), celS.EntireRow) 'extract name
        If Not IsEmpty(celT) Then 'find next empty cell in target sheet
            Set celT = wT.Cells(wT.Rows.Count, celT.Column).End(xlUp).Offset(1)
        End If
        celT.Value = celS.Value
    End If