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.