Sorting a table of data into one column in ascending order

[matt3542]

Dear Forum,

I am relatively new to VBA and am struggling with the following task and as
such would really appreciate any help;

I have a table of data similar to the example below and I would like to use
a command button to automate the way it is displayed. Ideally I would like
the command button to sort the data in ascending order and display as one
continuous list in column A. Any help gratefully received, thankyou, Matt

col

A B C D E F

10 22 12 23 11 24
9 21 4 14 2 16
7 19 1 15 3 13
5 17 8 18 6 20

 

[Joel]

Sub SortData()
For ColCount = 2 To 6
Set LastCell_A = Cells(Rows.Count, 1).End(xlUp)
Set NewCell_A = LastCell_A.Offset(rowoffset:=1)
LastCell_X = Cells(Rows.Count, ColCount).End(xlUp).Row
Set CopyRange = Range(Cells(1, ColCount), _
Cells(LastCell_X, ColCount))
CopyRange.Copy Destination:=NewCell_A
Next ColCount

Set LastCell_A = Cells(Rows.Count, 1).End(xlUp)
Set SortRange = Range("A1", LastCell_A)
SortRange.Sort _
Key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlGuess
Columns("B:F").Delete
End Sub

 

[Stefi]

Assign this macro to a commandbutton:

Sub testcopy()
firstsheet = ActiveSheet.Name
Sheets.Add
secondsheet = ActiveSheet.Name
Sheets(firstsheet).Select
NoOfRows = Range("A1").End(xlDown).Row
NoOfCols = Range("A1").End(xlToRight).Column

For r = 1 To NoOfRows
Range("A" & r & ":F" & r).Select
Selection.Copy
Sheets(secondsheet).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True
Range("A" & (r) * NoOfCols + 1).Select
Sheets(firstsheet).Select
Next r
Application.CutCopyMode = False
Sheets(secondsheet).Select
Range("A1:A" & NoOfRows * NoOfCols).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

Regards,
Stefi

„matt3542†ezt írta:

 

[matt3542]

Hi Joel, apologies for the delay replying. Thankyou very much that worked
perfectly.
Regards
Matt

 

[matt3542]

Thanks Stefi, much appreciated

Assign this macro to a commandbutton:

Sub testcopy()
firstsheet = ActiveSheet.Name
Sheets.Add
secondsheet = ActiveSheet.Name
Sheets(firstsheet).Select
NoOfRows = Range("A1").End(xlDown).Row
NoOfCols = Range("A1").End(xlToRight).Column

For r = 1 To NoOfRows
Range("A" & r & ":F" & r).Select
Selection.Copy
Sheets(secondsheet).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True
Range("A" & (r) * NoOfCols + 1).Select
Sheets(firstsheet).Select
Next r
Application.CutCopyMode = False
Sheets(secondsheet).Select
Range("A1:A" & NoOfRows * NoOfCols).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

Regards,
Stefi

„matt3542†ezt írta:

 

[Stefi]

You are welcome! Thanks for the feedback!
Stefi

„matt3542†ezt írta: