Here's one way to copy the data on two different rows on one sheet, to a single column on another sheet. It should work no matter what sheet you are "on".
And, by the way, note that neither Select nor Activate is used.
Option Explicit
Sub CopyData()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim rSortRange As Range
Set WS1 = Worksheets("sheet1")
Set WS2 = Worksheets("sheet2")
WS2.Cells.Clear
With WS1
.Range("b2", .Cells(2, .Columns.Count).End(xlToLeft)).Copy
End With
WS2.Range("b3").PasteSpecial Paste:=xlPasteValues, skipblanks:=False, Transpose:=True
With WS1
.Range("b36", .Cells(36, .Columns.Count).End(xlToLeft)).Copy
End With
With WS2
.Range("b3").End(xlDown).Offset(rowoffset:=1).PasteSpecial Paste:=xlPasteValues, skipblanks:=False, Transpose:=True
Set rSortRange = .Range("B3", .Cells(Rows.Count, "B").End(xlUp))
rSortRange.Sort key1:=rSortRange, order1:=xlAscending, Header:=xlNo
.Range("b3").EntireColumn.AutoFit
End With
Application.CutCopyMode = False
End Sub
In case you wish to copy other rows, or more rows than just the two, here is a more generalized routine that allows you to enter multiple rows to copy/transpose/paste.
Also, since you are sorting, I chose to change the skipblanks parameter to True. The blanks will normall sort to the end anyway.
Option Explicit
Sub CopyData()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim rDest As Range
Dim rSortRange As Range
Dim aRows As Variant
Dim I As Long
Set WS1 = Worksheets("sheet1")
Set WS2 = Worksheets("sheet2")
Application.ScreenUpdating = False
Set rDest = WS2.Range("B3")
rDest.EntireColumn.Clear
aRows = Array(2, 36) 'Rows to copy
For I = LBound(aRows) To UBound(aRows)
With WS1
.Range(.Cells(aRows(I), 2), .Cells(aRows(I), .Columns.Count).End(xlToLeft)).Copy
End With
rDest.PasteSpecial Paste:=xlPasteValues, skipblanks:=True, Transpose:=True
Set rDest = WS2.Cells(WS2.Rows.Count, rDest.Column).End(xlUp).Offset(rowoffset:=1)
Next I
With WS2
Set rSortRange = .Range("B3", .Cells(Rows.Count, "B").End(xlUp))
rSortRange.Sort key1:=rSortRange, order1:=xlAscending, Header:=xlNo
.Range("b3").EntireColumn.AutoFit
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub