Copy data to another sheet and sort rows

[Brew]

How do I create a macro that will copy 500 rows of data in the range
A2:AC501 within sheet "Box500" and paste into sheet "BoxSort", then
sort the 250 even rows together (2, 4, 6,....498, 500), followed by
the 250 odd rows together (3, 5, 7,....497, 499) and copy and paste
the header row on row 1.

 

[ExcelChampion]

Tools/Macro/Record New Macro

Do the steps that you listed above and there you go.

 

[venkat1926]

try this macro and see whether you get what you want
if there is any bug post the line which gives the error and error message
the second macro undo is to remove the entries in sheet2 so that you can again test with odd number of rows or even number of rows in sheet 1.

sub test()
Dim j As Integer, k As Integer
Dim cfind As Range
Worksheets("sheet1").Activate

j = Range("a2").End(xlDown).Row
If j Mod 2 <> 0 Then j = j - 1
'MsgBox j
For k = 2 To j Step 2
Rows(k).Copy Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
Next
Rows(1).Copy Worksheets("sheet2").Cells(1, 1)
Rows(1).Copy Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
For k = 3 To j + 1 Step 2
Rows(k).Copy Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
Next

 Worksheets("sheet2").Activate

Set cfind = Cells.Find(what:=Range("a1").Value, lookat:=xlWhole)

j = cfind.Row
Range(Cells(2, 1), Cells(j - 1, 1).End(xlToRight)).Sort key1:=Range("a2"), header:=xlNo
Range(Cells(j + 1, "a"), Cells(j + 1, "a").End(xlDown).End(xlToRight)).Sort key1:=Range("a2"), header:=xlNo
Rows(j).Delete

End Sub

Sub undo()
Worksheets("sheet2").Cells.Delete
End Sub

 

[Brew]

venkat1926, this is great, however, can we modify this solution to only copy the cell results and not the formulas within the cells?

 

[venkat1926]

revised macro(revisions bold font)
==========================
Sub testtwo()

Dim j As Integer, k As Integer
Dim cfind As Range
Worksheets("sheet1").Activate

j = Range("a2").End(xlDown).Row
If j Mod 2 <> 0 Then j = j - 1
'MsgBox j
For k = 2 To j Step 2
Rows(k).Copy
Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Next
Rows(1).Copy Worksheets("sheet2").Cells(1, 1)
Rows(1).Copy Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
For k = 3 To j + 1 Step 2
Rows(k).Copy
Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Next

Worksheets("sheet2").Activate

Set cfind = Cells.Find(what:=Range("a1").Value, lookat:=xlWhole)

j = cfind.Row
Range(Cells(2, 1), Cells(j - 1, 1).End(xlToRight)).Sort key1:=Range("a2"), header:=xlNo
Range(Cells(j + 1, "a"), Cells(j + 1, "a").End(xlDown).End(xlToRight)).Sort key1:=Range("a2"), header:=xlNo
Rows(j).Delete
Range("a1").Select
End Sub

 

[Brew]

Thank you venkat1926, that works fine