如果A1与带有列表的工作表中的数据匹配，将数据从一个工作表传输到多个工作表

我有大约20-30张每天创build的表单，它们都以A1的名字开头，比如“Pamela Anderson”，我希望脚本在表单中find名为“List”的匹配文本，并在单元格B1中添加任何内容在列表中的“Pamela Anderson”旁边的单元格中。

列表从A3开始，最多从B35开始。 如果名称不在列表中，则不应将任何数据添加到B1中。

因此，如果在单元格A1中的“随机表名”中表示“Barrack”，并且在列表A5中有“Barrack”，而B5中有“Obama”，则应该将B5信息复制到“random sheetname”中并粘贴到B1中。 该脚本应search所有工作表并在可能的情况下添加数据。

我怎样才能做到这一点？

Answer 1

尝试这个

Option Explicit Sub main() Dim sht As Worksheet, listSht As Worksheet Dim listRng As Range, found As Range Set listSht = ThisWorkbook.Worksheets("List") With listSht Set listRng = .Range("A3:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) 'sets the list range dowwn to the last non empty cell in column "A" of "List" sheet End With For Each sht In ThisWorkbook.Worksheets If sht.Name <> listSht.Name Then Set found = listRng.Find(what:=sht.Range("A1").Value, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=True) If Not found Is Nothing Then found.Offset(, 1).Copy Destination:=sht.Range("B1") End If Next End Sub 

Answer 2

您可以在下面的方法中更改单元格的值，结果和查找范围

 Sub LookupMac() ' ' LookupMac Macro ' ' Keyboard Shortcut: Ctrl+m ' Dim lookupRange As Range Dim result As Variant Dim lookupValue lookupValue = Range("A1") For Each wks In Worksheets Set lookupRange = wks.Range("A5:B35") result = Application.VLookup(lookupValue, lookupRange, 2, False) If IsError(result) Then 'result = "" Range("B1").Value = "" Else 'MsgBox (result & " found in " & wks.Name) Range("B1").Value = result Exit For End If Next End Sub