title: Find cell with value, offset and copy range then paste basing data's date, then loop to findnext
body: <p>With th following Excel Sheet.</p>
  
  <p><a href="https://i.stack.imgur.com/dulJv.jpg" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/dulJv.jpg" alt="Following is the excel"></a></p>
  
  <p>I'm trying to do the following:</p>
  
  <ol>
  <li>Find the cell with Value, let's say "Sam", in range("B17:B25")</li>
  <li>Offset(0,5).resize(,8).copy</li>
  <li>Find the Date value of the Data row, and paste Data to range("B4:M4") according to the data's Date.</li>
  <li>Loop to find next.</li>
  </ol>
  
  <p>Here is what I got so far, don't know how to loop:</p>
  
  <pre><code>Sub getDat()
  
  Dim myFind As Range
      Dim pasteLoc As Range
      Dim payee, pasteMon As String
  
          Range("B5:M12").ClearContents
  
          With Sheet3.Cells
  
              payee = Range("B2").Text
  
              Set myFind = .Find(What:=payee, After:=Range("B16"), LookIn:=xlValues, _
                  LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                  MatchCase:=True, SearchFormat:=False)
  
                  If Not myFind Is Nothing Then
  
                      myFind.Offset(0, 3).Resize(, 8).Copy
  
                      pasteMon = myFind.Offset(0, 1).Text
  
                      With Range("B4:M4")
  
                          Set pasteLoc = .Find(What:=pasteMon, LookIn:=xlValues, _
                              LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                              MatchCase:=True, SearchFormat:=False)
  
                              If Not pasteLoc Is Nothing Then
  
                                  pasteLoc.Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                  SkipBlanks:=False, Transpose:=True
  
                              End If
  
                      End With
  
                  End If
  
          End With
   End Sub
  </code></pre>