如何将图纸（标签）名称匹配到单独的工作表中的范围，并将特定的文本返回到每个工作表

我有一个多张工作簿。 一张纸有两列数据。 这张纸的标题是“注释”，而其余的标题与在“注释”页的范围A1：A6中input的值相匹配。 B栏包含必须在A栏中的每个相应页上进行的注释。

例如，如果工作簿中的第二张纸的标题是“Gpu制造”，而“注释”的A1的值也是“Gpu制造”，那么我要在“注释”的单元格B1中input值“Gpu制造”表单元格F1。

接下来，如果工作簿中的第三张纸张标题为“Tesla GPU”，“Notes”纸张的A2中的值也是“Tesla GPU”，那么我需要将“注释”的单元格B2中的值input到单元格“Tesla 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制造“并且”注释“纸张的A1中的值也是”Gpu制造“，那么我要input”注释“的单元格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 

然后你在给布鲁斯·维恩的评论中写道：

“但是它仍然不会在每张表的F2单元中返回任何东西”

从“B”列中粘贴其值的目标单元格（从“F1”到“F2”）在“注释”

如果后者是真实的情况，那么只需要replace：

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

有：

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

最后你在给BruceWayne写的另一个评论中写道：

“这只是一个testing工作簿，以获得一个macros，因为在现实中，我将需要使用它有700多张工作簿匹配到一列，并返回该工作表的特定数据从第二列”笔记“表 – 威廉克劳福德1小时前”

这是完全不同的事情

我的代码在这里回答你原来的问题

如果你的需要改变，而不是张贴另一个问题

Answer 2

 Sub example() Dim wkSht As Worksheet Dim cel As Range For Each wkSht In ActiveWorkbook.Worksheets For Each cel In Sheets("Reporting").Range("B2:B200") If cel.Value = wkSht.Name Then wkSht.Range("D15").Copy Destination:=cel.Offset(0, 1) End If Next cel Next wkSht End Sub 

主要是，我添加了Acitveworkbook.Worksheets而不是Sheets 。 这应该确保活动的图书是正在运行的图书。 另外，请确保您有一个名为“报告”的工作表。 如果这不起作用，让我知道如何。

也意识到，它将在每个工作表上循环200个单元格。 这是最有效的方法吗？ 你在做那么大的循环，因为这个值在某个范围内？ 或者你真的需要检查每一个？ （我在想一个find可能会更好）

编辑：这是怎么回事，我在你的意见后切换：

 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 

编辑：刚刚意识到这基本上是user3598756做的：P

编辑3：好吧，首先， 积极地看到我上面添加的第二个代码位在工作簿中的工作簿模块中。 这应该为你工作，它为我做的：

然后运行后：

等等

根据您最近的评论：

 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