如果A1與工作表中的數據匹配，將數據從一張紙傳輸到多張

Question

我有大約20-30張每天創建的工作表，他們都以A1的名稱開頭，如「Pamela Anderson」，我想要該腳本在名爲「List」的工作表中查找匹配的文本，並將單元格B1中的任何內容添加到列表工作表中「Pamela Anderson」旁邊的單元格中。

該列表從A3開始，最多下降到B35。如果名稱不在列表中，它不應該向B1添加任何數據。因此，如果在單元格A1中的「隨機工作表名稱」中顯示「Barrack」，並且列表中的A5具有「Barrack」並且B5具有「Obama」，則應將B5信息複製到「random sheetname」並將其粘貼到B1。腳本應搜索所有工作表並在可能的情況下添加數據。

我該如何做到這一點？

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