VB Code to reorganize data

Hello:

Please refer to attached file.
I have data as shown in Sheet1.
I need BN Code to transpose these data as shown in Sheet2.
(Here i am showing for 2 Vendors, but need to go thru all data).
Just to let you know that in Sheet2,
Column B will be todays date,
Column A will be "YES"
Column C will be "Bill"
Colunn D will be Bill#
Colunn E will be Name of Vendor
Column F will be "Account Payable"
Column L will be Amount.

Let me know if you have any questions.
Thanks.
Riz

Sub Reorg()
Dim ws As Worksheet
Dim headings As String
Dim supplier As String
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long

    Applic ation.ScreenUpdating = False
    
    headings = "New Transaction,Date,Type,Bill#,Name,Source Account,Account,Class,Item,Qty,Price Each,Amount"
    
    Set ws = Worksheets("Sheet2")
    If ws.Range("A1") = vbNullString Then
    
        ws.Range("A1").Resize(, Len(headings) - Len(Replace(headings, ",", vbNullString)) + 1).Value = Split(headings, ",")
        nextrow = 2
    Else
    
        nextrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    End If
    
    With Worksheets("Sheet1")
    
        lastrow = .Cells(.Rows.Count, "E").End(xlUp).Row
        i = 1
        
        For i = i To lastrow
        
            Do Until .Cells(i, "C").Value = "Vendor :"
                
                i = i + 1
            Loop
            supplier = .Cells(i, "D").Value
            
            Do Until IsNumeric(.Cells(i, "E").Value) And .Cells(i, "E").Value <> vbNullString
                
                i = i + 1
            Loop
            
            Do Until .Cells(i, "E").Value = vbNullString
            
                nextrow = nextrow + 1
                
                ws.Cells(nextrow, "A").Value = "YES"
                ws.Cells(nextrow, "B").Value = Date
                ws.Cells(nextrow, "C").Value = "Bill"
                ws.Cells(nextrow, "D").Value = .Cells(i, "E").Value
                ws.Cells(nextrow, "E").Value = supplier
                ws.Cells(nextrow, "F").Value = "Account Payable"
                ws.Cells(nextrow, "L").Value = .Cells(i, "N").Value
                
                i = i + 1
            Loop
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub

Hello Bob:

Thanks a loy.
Please refer to attached file with the above code and result.
It gets wrong result from Vendor #5

Please let me know if you have any questions.
Thanks.

Riz

As a beginner starter :

PHP Code: 

Sub Demo1()
     Dim L&, Rg As Range, R&
         L = 2
         Sheet2.UsedRange.Offset(1).Clear
         Application.ScreenUpdating = False
    With Sheet1.UsedRange.Columns(5)
           Set Rg = .Find("Bill #", , xlValues, xlWhole)
        If Not Rg Is Nothing Then
                R = Rg.Row
            Do
                With Rg(3).CurrentRegion
                    .Copy Sheet2.Cells(L, 4)
                     Sheet2.Cells(L, 5).Resize(.Count).Value2 = Rg(0, 0).Value2
                     Sheet2.Cells(L, 12).Resize(.Count).Value2 = .Offset(, 9).Value2
                     L = L + .Count
                End With
                   Set Rg = .FindNext(Rg)
            Loop Until Rg.Row = R
                   Set Rg = Nothing
        End If
    End With
    With Sheet2.Rows("2:" & L - 1).Columns
        .Item("A:C").Value = Array("YES", Date, "Bill")
        .Item(6).Value2 = "Account Payable"
        .Item(12).NumberFormat = "#,##0.00"
    End With
         Application.ScreenUpdating = True
End Sub 


Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

Hello:

Thanks a lot, Marc your code works

R