Excel VBA代码以在一个工作簿中select包含特定文本string的单元格，然后将这些单元格复制并粘贴到新的工作簿

我在Excel电子表格的单个列中包含一大组数据。 我一直在试图找出一种方法来自动化一个方法，从一个工作簿中的列中select某些数据，并将其粘贴到一个新的工作簿中。

例如，我在列中有一个名称列表。 我想select任何包含文本“名字：”的单元格，然后将这些单元格复制并粘贴到不同工作簿中的列中。

我可以使用Excel中的“查找所有”工具手动执行此操作，使用“Find what：”select单元格，然后使用Ctrl + Aselect所有find的项目，然后closures“Find All”工具，并使用Ctrl + C复制所有单元格，移至下一个工作簿，然后使用Ctrl + V粘贴这些单元格。 但是，我需要做这个过程很多次，不幸的是，macroslogging器不logging在“查找全部”工具中执行的任何查询/进程。

我假设我需要一些VBA代码，但一直没有find任何适合的网站/论坛。

Answer 1

这只是一个让你开始的样本：

Sub Luxation() Dim K As Long, r As Range, v As Variant K = 1 Dim w1 As Workbook, w2 As Workbook Set w1 = ThisWorkbook Set w2 = Workbooks.Add w1.Activate For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange) v = r.Value If InStr(v, "First name") > 0 Then r.Copy w2.Sheets("Sheet1").Cells(K, 1) K = K + 1 End If Next r End Sub 

该代码打开一个新的工作簿，返回到原始工作簿，运行列A ，然后将相关的单元格复制到新的工作簿。

编辑＃1

这是新的macros：

 Sub Luxation2() Dim K As Long, r As Range, v As Variant K = 1 Dim w1 As Worksheet, w2 As Worksheet Set w1 = Sheets("raw data") Set w2 = Sheets("data manipulation") w1.Activate For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange) v = r.Value If InStr(v, "First name") > 0 Then r.Copy w2.Cells(K, 1) K = K + 1 End If Next r End Sub