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

Question

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

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

我可以使用＆＃39;查找全部＆＃39; Excel中的工具，使用＆＃39;查找内容：＆＃39;选择单元格，然后使用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