Excel VBA代码，用于在一个工作簿中选择包含特定文本字符串的单元格，然后将这些单元格复制并粘贴到新工作簿中

Question

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

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

我可以使用Excel中的“全部查找”工具手动执行此操作，使用“查找内容：”选择单元格，然后使用Ctrl + A选择找到的所有项目，然后关闭“查找全部”工具，并使用Ctrl + C复制所有单元格，继续下一个工作簿，然后使用Ctrl + V粘贴这些单元格。 但是，我需要做很多次这个过程，不幸的是，宏录制器不会记录在“查找全部”工具中执行的任何查询/过程。

我假设我需要一些VBA代码，但无法在网络/论坛上找到任何合适的东西。

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

这是新的宏：

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