如果 A1 与 sheet 列表中的数据匹配，则将数据从一个 sheet 转移到多个

Question

我每天创建大约 20-30 个 sheets，它们都以 A1 中的名称开头，例如 "Pamela Anderson"，我希望脚本在sheet 调用了 "List" 并在单元格 B1 中添加列表 sheet.

中 "Pamela Anderson" 旁边单元格中的任何内容

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

因此，如果在单元格 A1 的 "random sheetname" 中显示 "Barrack" 并且在列表 A5 中有 "Barrack" 并且 B5 有 "Obama"，它应该将 B5 信息复制到"random sheetname" 粘贴到B1。该脚本应搜索所有 sheet 并在可能的情况下添加数据。

我怎样才能做到这一点？

Answer 1

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

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

Answer 2

试试这个

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

如果 A1 与 sheet 列表中的数据匹配，则将数据从一个 sheet 转移到多个

Transfer data from one sheet to multiple if A1 matches with data in the sheet with list

excel

vba

copy-paste