Combining multiple rows into one row

Try this:

Option Explicit

Sub MergeRows()
Dim LR As Long, RW As Long, delRNG As Range

With ActiveSheet
    .Range("A:Y").Sort Range("B2"), xlAscending, Header:=xlYes
    .Range("V:Y").Cut
    .Columns("N:N").Insert Shift:=xlToRight
    .Range("R:Y").Replace What:=" ", Replacement:="", LookAt:=xlPart
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    
    For RW = LR To 3 Step -1
        If .Range("B" & RW) = .Range("B" & RW - 1) Then
            .Range("R" & RW).Resize(, 100).SpecialCells(xlConstants).Copy .Cells(RW - 1, .Columns.Count).End(xlToLeft).Offset(, 1)
            If delRNG Is Nothing Then
                Set delRNG = .Range("A" & RW)
            Else
                Set delRNG = Union(delRNG, .Range("A" & RW))
            End If
        End If
    Next RW
    
    If Not delRNG Is Nothing Then delRNG.EntireRow.Delete xlShiftUp
End With

End Sub