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

时间:2016-05-24 15:29:20

标签: excel vba excel-vba copy-paste

我目前正在尝试搜索"引用ID:"在工作簿1的A列中,然后复制B列中它旁边的单元格,然后将该单元格粘贴到工作簿2中的单元格B67中。

有什么想法吗?我发现了一些类似于我需要的编码,但它们都比我需要的更复杂,而且他们正在复制整行而不是相邻的单元格。

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

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

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

我希望这对你有用