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

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

Try this

Code:

---

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

---

Please use puctuation marks in your posts.

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

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"

Code:

---

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.

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.