Столбец Сортировка не сортировка ссылочной колонки, только в активном столбце

Question

Я пытаюсь адаптировать некоторый код, который копирует и вставляет два отдельных диапазона в другой на другом листе, а затем сортирует его по алфавиту. Проблема в том, что я скрываю лист - хотя я покажу и снова скрываю его для запуска макроса - он, похоже, сортируется только в Active Column.

Я выделил полужирный код сортировки во втором макросе ниже. Макрос GetNamesList вызывает ConsolidateList в конце его кода.

GetNamesList устанавливается для работы на книгу открытой:

Private Sub Workbook_Open() 
GetNamesList 
End Sub 

Исходный код для GetNamesList от: http://bit.ly/1y3dU6n от @ Сиддхарт-маршрутным

Sub GetNamesList() 
Dim rng As Range, aCell As Range 
Dim MyAr() As Variant 
Dim n As Long, i As Long 

Application.ScreenUpdating = False 
Sheet28.Visible = True 

'~~> Change this to the relevant sheet 
With Sheet3 
    '~~> Non Contiguous range 
    Set rng = .Range("Table2[Contact 1],Table2[Contact 2]") 

    '~~> Get the count of cells in that range 
    n = rng.Cells.Count 

    '~~> Resize the array to hold the data 
    ReDim MyAr(1 To n) 

    n = 1 

    '~~> Store the values from that range into 
    '~~> the array 
    For Each aCell In rng.Cells 
     MyAr(n) = aCell.Value 
     n = n + 1 
    Next aCell 
End With 

'~~> Output the data in Sheet 

'~~> Vertically Output to sheet 28 
Sheet28.Cells(1, 1).Resize(UBound(MyAr), 1).Value = _ 
Application.WorksheetFunction.Transpose(MyAr) 

ConsolidateList 

Sheet28.Visible = False 
Application.ScreenUpdating = True 
End Sub 

ConsolidateList является:

Sub ConsolidateList() 
' 
' ConsolidateList Macro 
' Remove duplicates and blanks 
' 

    With Sheet28.Range("A1:A1000") 
    .Value = .Value 
    .RemoveDuplicates Columns:=1, Header:=xlNo 
    On Error Resume Next 
    .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp 
    On Error GoTo 0 
End With 

Столбцы («A: A»). Ключ сортировки1: = Диапазон (" A1"), Заказ1: = xlAscending

End Sub 

Спасибо за вашу помощь ...

** Обновление - запись макроса, чтобы сделать то же самое ...

Sub TestSort() 
' 
' TestSort Macro 
' 
Sheets("Jan").Select 
Sheets("Sheet1").Visible = True 
ActiveWindow.SmallScroll Down:=-405 
Range("A1:A134").Select 
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _ 
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
With ActiveWorkbook.Worksheets("Sheet1").Sort 
    .SetRange Range("A1:A134") 
    .Header = xlGuess 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
ActiveWindow.SmallScroll Down:=-245 
Sheets("Sheet1").Select 
ActiveWindow.SelectedSheets.Visible = False 
End Sub 

Answer 1

Спасибо @ТАК. Принимая ваше предложение и ломать голову над записанным кодом я смог сколотить следующее:

Sub ConsolidateList() 
' 
' ConsolidateList Macro 
' Remove duplicates and blanks 
' 

    With Sheet28.Range("A1:A1000") 
    .Value = .Value 
    .RemoveDuplicates Columns:=1, Header:=xlNo 
    On Error Resume Next 
    .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp 
    On Error GoTo 0 
End With 

Sheet28.Sort.SortFields.Clear 
Sheet28.Sort.SortFields.Add Key:=Range("A1"), _ 
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
With ActiveWorkbook.Worksheets("Sheet1").Sort 
    .SetRange Range("A1:A134") 
    .Header = xlGuess 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 

End Sub 

Хотя ActiveWorkbook, кажется, пробрался туда ...!

** UPDATE

Заменено

With ActiveWorkbook.Worksheets("Sheet1").Sort 
    .SetRange Range("A1:A134") 

С:

В верхней

Dim Lastrow As Integer

Тогда

Lastrow = Sheet28.Cells.Find("*", searchorder:=xlByRows,searchdirection:=xlPrevious).Row 
    With Sheet28.Sort 
    .SetRange Range("A1:A" & Lastrow) 

Это фиксированное ...