vba excel查找指定内容并复制到指定单元区域

Question

我想同时在多个工作表里查找指定内容然后复制找到的这个单元格及同一行前两列的值到另一张表的指定区域，同时把表名也写到这一区域！如查找到的值在D12,则复制A12到D12的内容到指定区域，指定区域的第一列为原数据的表名，第二列粘贴复制的内容，请问这段代码应该怎么写？

Answer 1

把你的表发个示例到[email protected]
写好再发给你

Answer 2

这个代码倒是好写，不过你的指定内容是什么？你的表格最大列和最大行数是多少?或者说你的表格从a1单元格起是连续区域吗？只有知道这些才能帮你写代码？追问

指定内容是一个单词，我的数据不多，列只是大概6列，行大概只有不到80行，查找的区域是每个工作表的D列里查找。

追答

什么单词你倒是说清楚呀？

追问

out

追答

Sub 粘贴()
Dim sh As Worksheet, a, b, c As Integer
For Each sh In Worksheets
If sh.Name "粘贴表" Then
a = Application.CountA(sh.[b:b])
For b = 1 To a
If sh.Cells(b, 4) = "out" Then
sh.Range("b" & b & ":" & "c" & b).Copy Sheets("粘贴表").Cells(c + 1, 2)
Sheets("粘贴表").Cells(c + 1, 1) = sh.Name
End If
c = Application.CountA(Sheets("粘贴表").[a:a])
Next b
End If
Next
End Sub

在你的工作簿中，插入一张表格，将其命名为粘贴表，然后将代码复制到VBA编辑窗口，执行代码。代码我以测试成功。

本回答被提问者和网友采纳