title: Looping through columns to find search criteria and paste cell values from another sheet beneath the criteria
body: <p>The workbook contains three sheets:</p>
  
  <ol>
  <li><p>Item-style (contains in colA the item no., colB the style of the item)</p></li>
  <li><p>Style (List of styles we want)</p></li>
  <li><p>Style template (List of items within the styles specified in the cols)</p></li>
  </ol>
  
  <p>I need a macro that does three things:</p>
  
  <ol>
  <li><p>Copy the list of styles from the Style sheet and paste &amp; transpose in Style template starting from row 2. Row 1 of all columns needs to be left blank.</p></li>
  <li><p>The macro needs to select each style in style template one by one, which is now in different columns. These will be the search criteria.</p></li>
  <li><p>On the basis of style selected in step 2, the macro needs to do a search in item-style sheet and select all the items that have the selected style and paste all these items beneath the corresponding style in style-template sheet. If there are no items corresponding to the selected style, then it should mention "No items" beneath the corresponding style.</p></li>
  </ol>
  
  <p>Here's a link to the workbook for easy understanding</p>
  
  <p><a href="https://docs.google.com/file/d/0BwbMoFdD00_uRE55WlhwWEd2QmM/edit?usp=sharing" rel="nofollow noreferrer">StyleProject</a></p>
  
  <p>Though the workbook mentions only three styles the macro should have the capability of working with more than 50 styles.</p>
  
  <p>Here's the code I have:</p>
  
  <pre><code>Sub StyleProject()
  Application.ScreenUpdating = False
  
  Dim ws As Worksheet
  Dim ws2 As Worksheet
  Dim ws3 As Worksheet
  
  Set ws = Sheets("Item-Style")
  Set ws2 = Sheets("Style")
  Set ws3 = Sheets("Style Template")
  
  Dim rng As Range, secRng As Range
  
  Dim i, j, k
  
  Sheets("Style Template").Activate
  finalcol = Cells(2, 50).End(x1toleft).Column
  
  For i = 2 To finalcol
  
  j = Cells(2, i).Value
  
  lr = ws.Range("A" &amp; Rows.Count).End(xlUp).Row
  
  For k = 2 To lr
      Set rng = ws.Range("B" &amp; i)
  
      If StrComp(CStr(rng.Text), j, 1) = 0 Then
          ws.Rows(k &amp; ":" &amp; k).Copy
          nxtRow = ws3.Range(i &amp; Rows.Count).End(xlUp).Row + 1
          ws2.Rows(nxtRow &amp; ":" &amp; nxtRow).PasteSpecial Paste:=xlPasteValues, _
          Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  
  
           Set rng = Nothing
              End If
          Next k
  
  Next i
  Application.ScreenUpdating = True
  End Sub
  </code></pre>
  
  <p>It ends up in error trying to figure out nextrng I believe.</p>