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

我正在尝试在工作簿1的列A中search“引用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 

我希望这对你有用