Don't know if this will work, so save the file you already have under a new name to keep your old information safe. I also don't know if this will also grab the words that have capital letters instead.


Dim rng as Range
Dim J as integer

Sheets("Sheet1").Select
For each rng in Range("A1:A7000")

If rng.FormulaR1C1 = "diagnosis" Then

rng.EntireRow.Select

Selection.Copy

Sheets("Sheet2").Select

J= J+ 1
Range("A" & J).Select

ActiveSheet.Paste

Sheets("Sheet1").Select
rng.EntireRow.Delete

End If

Next rng