title: VBA Looping Through Worksheet to find multiple instances of word
body: <p>I am trying to write a macro for <a href="/questions/tagged/excel" class="post-tag" title="show questions tagged 'excel'" rel="tag">excel</a> that searches <code>Sheet1</code> and </p>
  
  <ul>
  <li>finds all instances of the words <em>Force</em> and <em>Grade</em>, then</li>
  <li>copies the cells beneath those words (all cells to the first empty row), and pastes to <code>Sheet2</code>.</li>
  </ul>
  
  <p>These words (<em>Force</em> and <em>Grade</em>) can be found in any cell in Worksheet1 and the size of the used area changes every time the file is created. </p>
  
  <p>So far, I can only get it to find the first instance of each word. I have tried many types of loops from examples on this website and others.</p>
  
  <p>I feel like this should be simple, so I am not sure why I can't find the solution.  I have tried a For Next Loop that starts with <code>For i To ws.Columns.Count</code> (with "ws" set to Sheet1), but it turns into an infinite loop (although the total column count was only around 15). Any help or nudge in the right direction would be appreciated.   </p>
  
  <p>Here is the code that works so far:</p>
  
  <p><strong>my code</strong></p>
  
  <pre><code>'COPY AND PASTE ALL FORCE VALUES TO FROM SHEET1 TO SHEET2
  Sheets("Sheet1").Select
  Cells.Find(What:=strSearch1, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
      xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
      , SearchFormat:=False).Activate
  ActiveCell.Offset(1, 0).Activate   'select cell below the word "Force"
  Range(ActiveCell, ActiveCell.End(xlDown)).Select    'select all cells after "Force" to first empty cell
  numBonds = Range(ActiveCell, ActiveCell.End(xlDown)).Count
  Selection.Copy
  Sheets("Sheet2").Select
  Cells(Selection.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Select 'paste to next column
  ActiveSheet.Paste
  </code></pre>