Combining multiple rows of data into one row

try it

Sub ertert()
Dim x, y(), i&, j&, k&, n&, s$, ubx&
x = Intersect(Range("A:J"), ActiveSheet.UsedRange).Value
Intersect(Range("A:J"), ActiveSheet.UsedRange).Select
ubx = UBound(x, 2): ReDim y(1 To UBound(x, 1), 1 To ubx)

With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        s = x(i, 1) & "|" & x(i, 3)
        If Len(s) > 1 Then
            If .Exists(s) Then
                n = .Item(s)
                For k = 1 To ubx
                    If Len(y(n, k)) = 0 Then y(n, k) = x(i, k)
                Next k
            Else
                j = j + 1: .Item(s) = j
                For k = 1 To ubx
                    y(j, k) = x(i, k)
                Next k
            End If
        End If
    Next i
End With

Range("A1").Resize(UBound(x, 1), ubx).Value = y()
End Sub