Move Duplicate Vertical to Horizontal

The macro below starts at the bottom of the sheet working its way up. If the bottom sale number is the same as the previous then the description and amount are appended to the previous row until the end of the row is reached, then the old lower row is deleted.

Try it on a back up copy of your workbook, in case your actual column layout is not the same as the sample.

Option Explicit
Sub CountSalesIDs()
    'Ben Van Johnson, Excel Forum 12/17/2010
    
    Dim TestCell        As Range, _
        RefCell         As Range, _
        DataSheetName   As String, _
        HeaderRow       As Long, _
        HeaderColumn    As Long, _
        TestRow         As Long, _
        NextCol         As Long, _
        lastcol         As Long, _
        HeaderParm

    
    'find the cell with the first table header
    With Cells
        Set HeaderParm = .Find("Sales Number")
        HeaderRow = HeaderParm.Row
        HeaderColumn = HeaderParm.Column
    End With
    
    'get row of the last sale number
    SalesCount = Cells(Rows.Count, HeaderColumn).End(xlUp).Row
    
    'Start at the bottom of the sheet, testing the sale number against the one above
    'if they are the same, then append the description and amount from the lower
    'line to the upper line
    'When there are several repeats of a sale number the lowest record is alway at the end

    For TestRow = SalesCount To HeaderRow - 1 Step -1
                
        'get the last column of the current line
        lastcol = Cells(TestRow, Columns.Count).End(xlToLeft).Column
        
        'get the column where data is to be appended
        NextCol = lastcol + 1
        
        'compare the sales numbers
        If Cells(TestRow, HeaderColumn).Value = Cells(TestRow - 1, HeaderColumn).Value Then
        
            'start with the description column and move right to the end if the row
            For Each RefCell In Range(Cells(TestRow, HeaderColumn + 2), Cells(TestRow, lastcol))
            
                'increment the column to append to
                NextCol = Cells(TestRow - 1, Columns.Count).End(xlToLeft).Column + 1
                
                'copy the current data to the end of the upper row
                Cells(TestRow - 1, NextCol).Value = RefCell.Value
                
                'if the new append column has no header, then
                'check if the value just copied is a text string

                If Cells(HeaderRow, NextCol).Value = "" Then
                
                    If WorksheetFunction.IsText(RefCell.Value) Then
                        Cells(HeaderRow, NextCol).Value = "Discount Reason"
                    Else
                        Cells(HeaderRow, NextCol).Value = "Discount Amount"
                    End If
                End If
                NextCol = NextCol + 1
            Next RefCell
        
        'delete the current row, i.e., the one just appended to the upper row
        Range(Cells(TestRow, 1).Address).EntireRow.Delete
        End If
    Next TestRow
End Sub