OzGrid

Sub Main()
  Dim VendorCell As Range, SearchRange As Range
  Dim FirstVendorCell As String
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim r2 As Range, i As Long
  
  Set ws1 = Worksheets("Sheet1")
  Set ws2 = Worksheets("Sheet2")
  
  Set SearchRange = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp))
  Set VendorCell = SearchRange.Find("Vendor", MatchCase:=True)

  If VendorCell Is Nothing Then
    MsgBox "No Vendor was found"
    Exit Sub
  Else
    FirstVendorCell = VendorCell.Address
    Do
      Set r2 = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      i = 1
      If VendorCell(, 5).Value = "*" Then Exit Sub 'Vendor, ws1 Column E
      Do While VendorCell(9 + i, 11).Value <> ""
        r2(i).Value = VendorCell(, 5).Value 'Vendor, ws1 Column E
        r2(i, 2).Value = VendorCell(9 + i, 15).Value 'Reference, ws1 Column O
        r2(i, 3).Value = VendorCell(9 + i, 11).Value '$, ws1 Column K
        r2(i, 4).Value = VendorCell(9 + i, 8).Value 'Date, ws1 Column H
        i = i + 1
      Loop
      Set VendorCell = SearchRange.FindNext(VendorCell)
    Loop While VendorCell.Address <> FirstVendorCell
  End If
End Sub