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