[英]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
I have a large set of data contained within single column in an Excel spreadsheet. 我在Excel电子表格的单列中包含大量数据。 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.
我一直试图找到一种方法来自动化方法,从一个工作簿中的此列中选择某些数据,并将其粘贴到新工作簿的列中。
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. 我可以使用Excel中的“全部查找”工具手动执行此操作,使用“查找内容:”选择单元格,然后使用Ctrl + A选择找到的所有项目,然后关闭“查找全部”工具,并使用Ctrl + C复制所有单元格,继续下一个工作簿,然后使用Ctrl + V粘贴这些单元格。 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.
但是,我需要做很多次这个过程,不幸的是,宏录制器不会记录在“查找全部”工具中执行的任何查询/过程。
I'm assuming that I need some VBA code, but have been unable to find anything suitable on the web / forums. 我假设我需要一些VBA代码,但无法在网络/论坛上找到任何合适的东西。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.