从工作表2search和粘贴数据到工作表1表格

我有Sheet1这是一个窗体，其中我们input数据在数据库（Sheet2）中input的字段。

理想情况下，这是我想要的：

我想使用Sheet1中的表单内容search一个字段/logging，然后在Sheet2上search该项。 如果Sheet2上不存在，给我一个popup消息说数据不存在。

如果它在Sheet2的列A中存在，则select结果右侧的单元格（B列）。 然后将该单元格的内容粘贴到Sheet1上的相关字段中。然后继续操作，直到在Sheet2上search到Sheet1上的所有字段。

这是我一直在使用的代码。 在出现错误之前它只能运行大约5行。 任何帮助将不胜感激。

我真的不希望MsgBoxpopup。

Sub abc() Do Until IsEmpty(ActiveCell) Dim MyString As String MyString = ActiveCell Sheets("Sheet2").Select Set RangeObj = Cells.Find(What:=MyString, After:=ActiveCell, _ LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False) If RangeObj Is Nothing Then MsgBox "Not Found" Else: RangeObj.Select ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select ActiveCell.Offset(0, 1).Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveCell.Offset(-1, -1).Select Loop End Sub 

请让我知道我做错了什么。

Answer 1

你是在正确的道路上，只是对你如何复制数据的一些修改。

 Option Explicit Sub sheet2_lookup() Dim strVal As String Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet, RangeObj As Range Set wb = ThisWorkbook Set ws1 = wb.Sheets("Sheet1") Set ws2 = wb.Sheets("Sheet2") Cells(1, 1).Activate '' amend this to your starting cell While ActiveCell.Value2 <> "" strVal = ActiveCell.Value2 Set RangeObj = ws2.Columns("A").Find(What:=strVal, After:=Cells(1, 1), LookIn:=xlValues) If RangeObj Is Nothing Then MsgBox "Not Found" Else ActiveCell.Offset(0, 1).Value2 = RangeObj.Offset(0, 1).Value2 End If ActiveCell.Offset(1, 0).Activate Wend End Sub 

让我知道事情的后续。