搜索一个单词，然后将其旁边的单元格复制到另一个带有VBA的Excel工作簿中

Question

我当前正在尝试在工作簿1的A列中搜索“报价ID：”，然后在列B中复制它旁边的单元格，然后将该单元格粘贴到工作簿2的单元格B67中。

有任何想法吗？ 我发现了一些与我所需的编码相似的编码，但是它们都比我所需的要复杂得多，并且它们正在复制整行而不是相邻的单元格。

Answer 1

从这里开始：

Sub SingleCell()
    Dim r1 As Range, r2 As Range

    Set r1 = Workbooks("Book1").Sheets("Sheet1").Range("A:A").Find(What:="Quote ID:").Offset(0, 1)
    Set r2 = Workbooks("Book2").Sheets("Sheet1").Range("B67")
    r1.Copy r2
End Sub

Answer 2

那不应该太难。 但是您必须填写工作簿和工作表名称才能使其正常工作。

Sub searchMacro()

Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim srch As String
Dim col As Range, pstCell As Range, sRng As Range

'Identify workbooks
Set wb1 = Workbooks("workbook to search IDs Name")
Set wb2 = Workbooks("workbook to paste cell name")

'Identify worksheets
Set ws1 = wb1.Sheets("Sheet to search IDs Name")
Set ws2 = wb2.Sheets("Sheet to paste cell name")

'Input which Quote to search for. This is a pop-up windows for the user to input the value into
srch = InputBox("Input Quote ID:", "Search ID")

'Search Column
Set col = ws1.Columns("A")

'Paste Cell
Set pstCell = ws2.Range("B67")

'Search the column for the ID
Set sRng = col.Find(srch)

If Not sRng Is Nothing Then
    'Quote ID was found
    sRng.Offset(0, 1).Copy pstCell
Else
    'Quote ID was not found
    MsgBox "Quote ID " & srch & " was not found", vbCritical, "Not found"
End If

End Sub

希望对你有用