如何将工作表（选项卡）名称与单独工作表中的范围匹配，并将特定文本返回到每个工作表

Question

我有一张包含多张纸的工作簿。一张纸有两列数据。此表格标题为“备注”，而其余表格的标题与“备注”表格的范围A1：A6中输入的值相匹配。 B列包含必须在A列各张纸上的注释。

例如，如果工作簿中的第二个工作表标题为“Gpu制造”，并且“注释”工作表的A1中的值也是“Gpu制造”，那么我希望“注释”的单元格B1中的值进入“Gpu制造”表的单元格F1。

接下来，如果工作簿中的第3张标题为“Tesla GPU”，而“Notes”表中A2的值也是“Tesla GPU”，那么我希望“Notes”的单元格B2中的值为进入“特斯拉GPU”表的单元格F1。

冲洗并重复以根据其名称或标题将“注释”表格中的数据保存到其他表格中。

这是我到目前为止所做的：

Sub example() 

    Dim wkSht As Worksheet

    For Each wkSht In Sheets

        For Each Cell In Sheets("Reporting").Range("B2:B200")

            If Cell.Value = wkSht.Name Then

                wkSht.Range("D15").Copy Destination:=Cell.Offset(0,1)

            End If

        Next Cell

    Next wkSht

End Sub

编辑BruceWayne：

这是我的VBA应用程序显示的内容：

Answer 1

你先写道：

“例如，如果WB中的第二张标题为”Gpu manufacturing“，而”Notes“表中A1的值也是”Gpu制造“，那么我想要在单元格B1中的值“注释”将输入“Gpu制造”表格的单元格F1中。“

从中派生出以下代码：

Sub Main()
    Dim cell As Range

    For Each cell In Worksheets("Notes").Range("A1:A6")
        Worksheets(cell.Value).Range("F1") = cell.Offset(,1)
    Next cell
End Sub

然后你在评论中写道：BruceWayne回答：

“但是它仍然没有在每张表格的F2单元格中返回任何内容”

哪些更改（从“F1”到“F2”）除“Notes”以外的工作表中的目标单元格从“B”列粘贴其值

如果后者是真实案例，那么只需替换：

Worksheets(cell.Value).Range("F1") = cell.Offset(,1)

使用：

Worksheets(cell.Value).Range("F2") = cell.Offset(,1)

最后你写了另一条评论给BruceWayne回答：

“这只是一个测试工作手册，以获取一个有效的宏，因为实际上，我需要在一个工作簿上使用它，该工作簿有700多页与列匹配并返回该表的特定数据“笔记”表上的第二栏 - 威廉克劳福德1小时前“

这是完全不同的事情

我的代码在这里回答您的原始问题

如果您的需求发生了变化，请发布另一个问题

Answer 2

Acitveworkbook.Worksheets

主要是，我添加了Sheets而不是find。这应该确保活动的书是正在运行的书。另外，请确保您有一张名为＆＃34;报告＆＃34;的表格。如果这不起作用，请告诉我是怎么回事。

同时意识到，它将在每个工作表上循环遍历200个单元格。这是最有效的方法吗？你是在做那个大循环，因为价值在那个范围内的某个地方？或者你真的需要检查每一个？ （我认为Sub example2() Dim wkSht As Worksheet Dim cel As Range Dim curShtName As String For Each sht In ActiveWorkbook.Worksheets sht.Name = Trim(sht.Name) Next sht For i = 1 To 6 ' Since we go from A1/B1 to A6/B6 curShtName = Worksheets("Notes").Cells(i, 1).Value If curShtName <> "Notes" Then Worksheets(curShtName).Cells(2, 6).Value = Worksheets("Notes").Cells(i, 2).Value End If Next i End Sub 可能会更好）

编辑：这个怎么样，我在你的评论之后切换了它：

Sub copyInfo()
Dim lastRow As Long
Dim notesWS As Worksheet

Set notesWS = ActiveWorkbook.Worksheets("Notes") ' This is the worksheet with the info. you want to copy over to other sheets
lastRow = notesWS.Cells(notesWS.Rows.Count, 2).End(xlUp).Row ' Assuming your Col. B has the most info

Dim myFacts() As Variant
myFacts = notesWS.Range(notesWS.Cells(1, 2), notesWS.Cells(lastRow, 2))

Dim i As Long
i = 1
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Notes" Then
        ws.Cells(2, 6).Value = myFacts(i, 1) 'This loops through our Array that we created above.
        i = i + 1
    End If
Next ws
End Sub

编辑：刚刚意识到这基本上就是用户3598756所做的：P

编辑3：好的，首先，使肯定我上面添加的第二个代码位在工作簿中的工作簿模块中。这应该对你有用，它对我有用：

然后运行它：

等等。

根据您最近的评论：

class_name: AcceptanceTester 

modules:
    enabled:
        - WebDriver:
            url: http://examplesite.com/?realm=ab-cd
            host: 'hostmaster@examplesite.com:mykey@hub.browserstack.com'
            port: 80
            browser: firefox
            capabilities:
                javascriptEnabled: true