vba Excel VBA代码在一个工作簿中选择包含特定文本字符串的单元格，然后将这些单元格复制并粘贴到新的工作簿中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/23389559/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA code to select cells that contain a certain text string in one workbook, and then copy and paste these cells into a new workbook
提问by user3568588
I have a large set of data contained within single column in an Excel spreadsheet. I have been trying to work out a way of automating a method to select certain data from this column in one workbook, and paste it into a column in a new workbook.
我在 Excel 电子表格的单列中包含大量数据。我一直在尝试找出一种自动化方法，从一个工作簿中的该列中选择某些数据，并将其粘贴到新工作簿中的一列中。
For example, I have a list of names in the column. I wanted to select any cells that contain the text "First name:", and then copy and paste these cells into a column in a different workbook.
例如，我在列中有一个名称列表。我想选择包含文本“名字：”的任何单元格，然后将这些单元格复制并粘贴到不同工作簿中的列中。
I can do this manually using the 'Find All' tool within Excel, selecting the cells using 'Find what:', and then using Ctrl+A to select all the items found, then closing the 'Find All' tool, and using Ctrl+C to copy all the cells, moving on to the next workbook, and then using Ctrl+V to paste these cells. However, I need to do this process quite a large number of times, and unfortunately the Macro recorder does not record any queries / processes performed in the 'Find All' tool.
我可以使用 Excel 中的“查找全部”工具手动执行此操作，使用“查找内容：”选择单元格，然后使用 Ctrl+A 选择找到的所有项目，然后关闭“查找全部”工具，并使用 Ctrl +C 复制所有单元格，移至下一个工作簿，然后使用 Ctrl+V 粘贴这些单元格。但是，我需要多次执行此过程，不幸的是，宏记录器没有记录在“查找全部”工具中执行的任何查询/过程。
I'm assuming that I need some VBA code, but have been unable to find anything suitable on the web / forums.
我假设我需要一些 VBA 代码，但一直无法在网络/论坛上找到任何合适的代码。
回答by Gary's Student
This is just a sample to get you started:
这只是让您入门的示例：
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
The code opens a fresh workbook, goes back to the original workbook, runs down column A, and then copies the relevant cells to the fresh workbook.
该代码打开一个新工作簿，返回到原始工作簿，向下运行A列，然后将相关单元格复制到新工作簿中。
EDIT#1
编辑#1
Here is the new macro:
这是新的宏：
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
