Copying rows to another worksheet based on a search on a grid of tags
I am having a problem with Excel that I was hoping someone could help me with.
I have a table where between columns K & Q are a number of tags. What I would like to do is have a function or a macro or something that will allow me to look within all these tags and copy any rows that contain a specific word to another worksheet.
e.g.
I J K L M N O etc.
1 blah blah funding blah blah blah blah
2 funding 开发者_如何学Goblah blah blah blah blah blah
3 blah blah blah blah blah blah blah
4 blah blah blah blah blah blah blah
5 blah blah blah blah blah funding blah
6 blah blah funding blah blah blah blah
There is other information in columns A to H that I will also need to copy across, but do not want to include in the search. So in this scenario, I would like to be able to search for the tag 'funding' and therefore copy rows 1, 2, 5 & 6 to a different worksheet.
Is this possible?
Here is the code. I give credit to tompols from this forum (I based my code off this): http://en.kioskea.net/forum/affich-242360-copy-row-if-a-range-of-column-matches-a-value
UPDATE: Code rewritten to be more effecient with some fantastic points from Jean-François Corbett implemented (thanks!). I also added a message box at the end that reports how many rows were copied over.
I customized the code to do what you needed it to do. What happens when you run the macro (make sure you aren't on sheet 2) is that a box appears. Enter the word you want to filter by (in your case funding), and it will look through K:Q for cells that contain it. It will copy the entire column when it finds a match into sheet 2.
Sub customcopy()
Application.ScreenUpdating = False
Dim lastLine As Long
Dim findWhat As String
Dim toCopy As Boolean
Dim cell As Range
Dim i As Long
Dim j As Long
findWhat = CStr(InputBox("Enter the word to search for"))
lastLine = ActiveSheet.UsedRange.Rows.Count
j = 1
For i = 1 To lastLine
For Each cell In Range("K1:Q1").Offset(i - 1, 0)
If InStr(cell.Text, findWhat) <> 0 Then
toCopy = True
End If
Next
If toCopy = True Then
Rows(i).Copy Destination:=Sheets(2).Rows(j)
j = j + 1
End If
toCopy = False
Next
i = MsgBox(((j - 1) & " row(s) were copied!"), vbOKOnly, "Result")
Application.ScreenUpdating = True
End Sub
Accepting answers (I noticed you are new here): If this works for you, please click the arrow that appear on the upper left to accept this answer. Thanks!
you can try recording a macro with the following steps:
- select the columns where you want to search (
K
andQ
if i understood well) - perform a search with a sample tag
- copy the row you found
- paste it to the other Sheet
you will then have a first sample of code to start with.
see here for some tips on how to clean up the code
精彩评论