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.
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.
I’m assuming that I need some VBA code, but have been unable to find anything suitable on the web / forums.
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.
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