找到相同的值并在其旁边粘贴数据

Question

我到处搜索，似乎无法在宏观上寻求帮助我正努力让生活变得更轻松。

我们有激光扫描仪和我正在尝试做的，是使用搜索框，以便我们可以扫描代码，然后检查完​​整的A列。

如果从A3中找到代码，它将粘贴数据，如A3，B3＆amp; C3表示E3，F3，G3。

目前我拥有的宏，查找数据（比如在A1中）然后将完整的A ROW复制到第2页，但我希望它全部放在一张纸上。

在搜索之前1111111

搜索后1111111

使用此代码

---

Option Explicit

Sub Main()
Application.ScreenUpdating = False
    Dim rangeToSearch As range
    Set rangeToSearch = Sheets(1).range("A2:A" & Sheets(1).range("A" & Rows.Count).End(xlUp).Row)

    Dim searchAmount As String
    searchAmount = InputBox("Type in the amount to search for:")

    Dim cell As range
    For Each cell In rangeToSearch
        If cell = CLng(searchAmount) Then
            Sheets(1).Rows(cell.Row & ":" & cell.Row).Copy
            Sheets(2).Rows( _
             Sheets(2).range("A" & Rows.Count).End(xlUp).Row + 1 & _
             ":" & _
             Sheets(2).range("A" & Rows.Count).End(xlUp).Row + 1 _
             ).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
        End If
    Next
Application.ScreenUpdating = True
End Sub

---

Answer 1

我稍微修改了你的代码，现在它更简单，没有loop语句：

Option Explicit

Sub Main()
   Application.ScreenUpdating = False
   Dim rangeToSearch As Range
   With Sheets(1)
      Set rangeToSearch = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
   End With

   Dim searchAmount As String
   searchAmount = InputBox("Type in the amount to search for:")

   Dim cell As Range

   Set cell = rangeToSearch.Find(searchAmount, LookIn:=xlValues)
   With Sheets(1)
      If Not cell Is Nothing Then
        .Range("E" & cell.Row & ":G" & cell.Row).Value = _
           .Range("A" & cell.Row & ":C" & cell.Row).Value
      Else
         MsgBox "Value " & searchAmount & " not found"
        .Range("L4").Value = searchAmount
      End If
   End With

   Application.ScreenUpdating = True
End Sub