Split Data From Single Column Set Into Multiple Column Sets?

Update:= I don't think the code below is what you want.
Looking at your question again I think you want each unique Number in "A" to have its own set of 2 columns to show results from "B & C", is that correct ??????, Please post expected results or attach file.

Try this:-
NB:= This code will delete the unwanted rows.

Sub MG24Nov27
Dim Rng As Range, Dn As Range, n As Long
Dim Q As Variant, nRng As Range
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
        If Not .Exists(Dn.Value) Then
            .Add Dn.Value, Array(Dn, 3)
       Else
           Q = .Item(Dn.Value)
                If nRng Is Nothing Then
                    Set nRng = Dn
                Else
                    Set nRng = Union(nRng, Dn)
                End If
                Q(0).Offset(, Q(1)).Resize(, 2).Value = Dn.Offset(, 1).Resize(, 2).Value
                Q(1) = Q(1) + 2
            .Item(Dn.Value) = Q
End If
Next
End With
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End Sub

Regards Mick

Hi,

Assuming your data starts in cell A1, this utilisation of autofilter should do as you require.

Sub extract()
Dim iLastRow As Integer, iMaxFilter As Integer, iLoop As Integer

iLastRow = Range("A" & Rows.Count).End(xlUp).Row
iMaxFilter = Application.WorksheetFunction.Max(Range("A:A"))

For iLoop = 1 To iMaxFilter

Range("A1").AutoFilter
    ActiveSheet.Range("$A$1:$C$" & iLastRow).AutoFilter Field:=1, Criteria1:=iLoop
    
If Not Application.WorksheetFunction.Subtotal(2, Range("A:A")) = 0 Then
    Range("A1:C" & iLastRow).Select
    Selection.Copy
    Cells(1, Columns.Count).End(xlToLeft).Offset(0, 2).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFilter
End If
Next
End Sub

You could convert back from a list to a standard range:

This assumes that the data you import is the only table on the sheet:

ActiveSheet.ListObjects(1).Unlist