VBA To Split A Group Or Set Of Data In Rows In To Columns

[CORAL]

i have a sheet that has many columns and i want to sort them i attached an example sheet 2 is the sheet that must be changed in to sheet one

[Excel Fox]

Try this

Sub ColumnizeExcelFox()

    Dim lngLast As Long
    Const clngCol As Long = 2
    
    Worksheets("Sheet2").UsedRange.Clear
    With Worksheets("Sheet1")
        lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
        Do Until lngLast <= 1
            .Range(.Cells(lngLast, 1).End(xlUp)(0), .Cells(lngLast, clngCol)).Copy Worksheets("Sheet2").Cells(1)
            lngLast = .Cells(lngLast, 1).End(xlUp).Row - 2
            If lngLast > 0 Then
                Worksheets("Sheet2").Cells(1).Resize(, clngCol).EntireColumn.Insert
            End If
        Loop
    End With
    
End Sub

[snb]

Please use puctuation marks in your posts.

[Excel Fox]

Could you please clarify that, snb. Not sure what you were referring to.

[CORAL]

hi Mr
your code change sheet 1 in to sheet 2 but i want the code for changing sheet 2 into sheet 1
so i think(not sure) the subject should be changed in to:
"VBA To Split A Group Or Set Of Data In columns In To row"

[p45cal]

Sub blah()
Set SceSht = ActiveSheet
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Set Destn = NewSht.Cells(1, 1)
Application.Goto Destn

With SceSht
  lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
  For i = 1 To lc Step 2
    Set RngToCopy = Intersect(.UsedRange, .Cells(1, i).Resize(, 2).EntireColumn)
    RngToCopy.Copy Destn
    Set Destn = Destn.Offset(RngToCopy.Rows.Count)
    Application.Goto Destn
  Next i
End With
NewSht.Columns("A:B").AutoFit
End Sub

Acts on the active sheet as the source sheet, creates a new sheet.
The values seem to be be awry on your sheet 1.

[p45cal]

I've just realised that I left 2 debug lines in which don't need to be there; they are the 2 lines:
Application.Goto Destn
Delete them.