title: Search for text in excel sheet and extract range of cells to a table
body: <p>Regularly I have to extract some data from excel sheets. Most of the time the sheet is small enough to do this per hand, which means, looking for a specific string and manually copy-paste the cells of interest.</p>
  
  <p><a href="https://i.stack.imgur.com/H4uaa.png" rel="nofollow noreferrer">Example of an excel sheet</a></p>
  
  <p>This time I have a file with more than 5000 lines, which prevents me to do this as usual. This is a good occasion to write a simple code to do that automatically. The best way to do this in my case would be to:</p>
  
  <ul>
  <li>1) Look for the cells containing the term "text"</li>
  <li>2) For each cell:
  
  <ul>
  <li>2.1) Select a range of cells</li>
  <li>2.2) Copy the range of cells and paste it to this destination range</li>
  </ul></li>
  </ul>
  
  <p>As I am not used to code, I search on internet some code with similar behaviour. What I found so far is a code for the 1) step. In the following code, the addresses of the cells are written in a destination range:</p>
  
  <pre><code>Dim findWhat As String, address As String
  Dim fsr As Range, rs As Range, fCount As Long
  
  findWhat = InputBox("Enter what you want to find?", "Find what...")
  
  If Len(findWhat) &gt; 0 Then
      'clearFinds
      Set frs = Range("A1:AW6000")
      Set rs = frs.Find(What:=findWhat)
      If Not rs Is Nothing Then
          address = rs.address
          Do
              Range("bb1").Offset(fCount).Value = rs.Value
              Range("bc1").Offset(fCount).Value = rs.address
              Set rs = frs.FindNext(rs)
              fCount = fCount + 1
          Loop While Not rs Is Nothing And rs.address &lt;&gt; address
      End If
  End If
  </code></pre>
  
  <p>Regarding the step 2.1), I know that I have to implement this to select a range for each cell found in the step 1):</p>
  
  <pre><code>Range(ActiveCell, ActiveCell.Offset(4, 9))
  </code></pre>
  
  <p>Finally, I planned to use the following code for the step 2.2):</p>
  
  <pre><code>Worksheets("Sheet1").Range("A1:D4").Copy _ 
      destination:=Worksheets("Sheet2").Range("E5")
  </code></pre>
  
  <p>Despite my efforts, I don´t know how to code that properly to make this code working. Could someone give me a little help?</p>