Excel VBA：如何创build一个使用VBA的search引擎，将单元格的行复制到同一个工作表中的新选项卡上？

我试图让excel专注于包含我search的单元格。 因此，如果在search后，我的Excel电子表格中的单元格不在视图中，屏幕会自动调整到特定的单元格。 然后，我需要将单元格中的所有内容都放在同一个Excel电子表格中，并自动复制到一个新的选项卡中。 但在第二个选项卡中复制的行需要从第5行的列A开始并继续。 下面是我到目前为止的代码，我不太熟悉VBA，但我一直在努力。 任何帮助或见解将不胜感激。

`Option Explicit Sub FindWhat() Dim sFindWhat As String Dim sh1 As Worksheet Dim sh2 As Worksheet Dim sh3 As Worksheet Dim Search As Range Dim Addr As String Dim NextRow As Long Dim cl As Range Set sh1 = ThisWorkbook.Sheets("Sheet1") Set sh2 = ThisWorkbook.Sheets("Sheet2") Set sh3 = ThisWorkbook.Sheets("Sheet3") '// This will be the row you start pasting data on Sheet3 NextRow = 5 For Each cl In Intersect(sh1.UsedRange, sh1.Columns("A")).Cells '// the value we're looking for sFindWhat = cl.Value '// Find this value in Sheet2: With sh2.UsedRange Set Search = .Find(sFindWhat, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) If Search Is Nothing Then '// Get out of here if the value is not found '// Do NOT Exit the sub, we'll just proceed to next cell in column A 'Exit Sub Else '// Make sure next row in Sh3.Column("K") is empty While sh3.Range("K" & NextRow).Value <> "" NextRow = NextRow + 1 Wend '// Paste the row in column K of sheet 3: Search.Resize(1, 12).Copy Destination:=sh3.Range("K" & NextRow) End If End With Next End Sub 

Answer 1

尝试一下：

 Dim sh1 As Worksheet Dim sh2 As Worksheet Dim sh3 As Worksheet Dim rng As Range Dim IdRng As Range Dim SrcRng As Range Dim Search As Range Dim lRow1 As Long Dim lRow2 As Long Dim lRow3 As Long Set sh1 = ThisWorkbook.Sheets("Plan1") Set sh2 = ThisWorkbook.Sheets("Plan2") Set sh3 = ThisWorkbook.Sheets("Plan3") lRow1 = sh1.Range("A" & Rows.Count).End(xlUp).Row If lRow1 < 4 Then lRow1 = 4 Set IdRng = sh1.Range("A4:A" & lRow1) 'Dynamic ID's Range lRow2 = sh2.Range("L" & Rows.Count).End(xlUp).Row If lRow2 < 4 Then lRow2 = 4 Set SrcRng = sh2.Range("L3:L" & lRow2) 'Dynamic sheet2 search range For Each rng In IdRng Set Search = SrcRng.Find(What:=rng, LookIn:=xlValues) If Not Search Is Nothing Then lRow3 = sh3.Range("K" & Rows.Count).End(xlUp).Row If lRow3 < 5 Then lRow3 = 5 sh2.Range(Search.Address).EntireRow.Copy sh3.Range("K" & lRow3) 'dynamic paste range Else MsgBox rng & " was not found.", vbInformation, sh1.Name End If Next rng 

请记住将您的工作表的名称更改为Set sh1 = ThisWorkbook.Sheets("Plan1") ， Set sh2 = ThisWorkbook.Sheets("Plan2")和Set sh3 = ThisWorkbook.Sheets("Plan3") 。

此代码具有您的Id列（工作表1），search列（工作表2）和粘贴的列（工作表3）的dynamic范围，因此它将自动识别最后一个数据在哪个范围内。