VBA Sort Macro не работает

Question

Код сортировки больше не работает. Он работал в первый раз. Затем я закрыл его и открыл, а затем он дал мне ошибку. (. Я ничего не изменило) Это дало мне:

Ошибка 438: Объект не поддерживает это свойство или метод

На этой линии:

DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), SortOn:=xlSortOnValues, _ 
            Order:=xlAscending, DataOption:=xlSortNormal` 

фрагмент код сортировки:

'Alpahebtical order 
    DataSheet.Range("A1").Select 
    ActiveCell.Rows("1:1").EntireRow.Select 
    Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 
    FNOrdCol = ActiveCell.Address 
    DataWB.DataSheet.Sort.SortFields.Clear 
    DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _ 
     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 

    With DataWB.DataSheet.Sort 
     .SetRange DataSheet.Cells 
     .header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

Весь код:

Sub iGetData() 

Dim ValidatorWB As Workbook 
Dim PopDetail As Worksheet 
Dim DataSheetName As String 
Dim DataWB As Workbook 
Dim DataSheet As Worksheet 
Dim Ret 
Dim DWBName As String 
Dim FNOrder As String 
Dim FNOrdCol As String 

Set PopDetail = Worksheets("PopulateWireframe") 
Set ValidatorWB = Workbooks(ActiveWorkbook.Name) 
DataSheetName = Range("F18").Value 
FNOrder = Range("F33").Value 

Application.ScreenUpdating = False 

'Open data file 
Ret = IsWorkBookOpen(PopDetail.Range("C18").Value) 
If Ret = False Then 

Workbooks.Open PopDetail.Range("C18").Value 
DataFileName = ActiveWorkbook.Name 
Set DataWB = Workbooks(DataFileName) 
Set DataSheet = Worksheets(DataSheetName) 

Dim FilterColumn As String 
Dim FilterCriteria As String 
Dim ColumnNumber As Integer 

'Set filter 
With DataSheet 
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then 
    ActiveSheet.ShowAllData 
End If 
End With 

ValidatorWB.Activate 
PopDetail.Activate 

For x = 21 To 30 

If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then 

    FilterColumn = PopDetail.Range("E" & x).Value 
    FilterCriteria = PopDetail.Range("F" & x).Value 

    DataWB.Activate 
    DataSheet.Activate 

    DataSheet.Range("A1").Select 

    Selection.End(xlToLeft).Select 

    ActiveCell.Rows("1:1").EntireRow.Select 

    Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 

    ColumnNumber = ActiveCell.Column 

    DataSheet.AutoFilterMode = False 
    DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria 

End If 

    ValidatorWB.Activate 
    PopDetail.Activate 

'x = x + 1 

Next x 

    DataWB.Activate 
    DataSheet.Activate 

    'Alpahebtical order 
    DataSheet.Range("A1").Select 
    ActiveCell.Rows("1:1").EntireRow.Select 
    Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 
    FNOrdCol = ActiveCell.Address 
    DataWB.DataSheet.Sort.SortFields.Clear 
    DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _ 
     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 

    With DataWB.DataSheet.Sort 
     .SetRange DataSheet.Cells 
     .header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    'Copy data 
    Range("A1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 

    'Paste data to validator 
    ValidatorWB.Activate 
    ValidatorWB.Sheets.Add().Name = "ValidatorData" 
    ActiveCell.Offset(3, 0).Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=True 
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15 
    Application.CutCopyMode = False 

'DataWB.Close savechanges:=False 
If DataWB.Windows(1).Visible = True Then 
DataWB.Windows(1).Visible = False 
End If 

Application.ScreenUpdating = True 

PopDetail.Activate 

Else 

DWBName = GetFilenameFromPath(PopDetail.Range("C18").Value) 
Set DataWB = Workbooks(DWBName) 
DataWB.Activate 
Set DataSheet = Worksheets(DataSheetName) 
DataSheet.Activate 
With DataSheet 
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then 
    ActiveSheet.ShowAllData 
End If 
End With 

ValidatorWB.Activate 
PopDetail.Activate 

For x = 21 To 30 

If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then 

    FilterColumn = PopDetail.Range("E" & x).Value 
    FilterCriteria = PopDetail.Range("F" & x).Value 

    DataWB.Activate 
    DataSheet.Activate 

    DataSheet.Range("A1").Select 

    Selection.End(xlToLeft).Select 

    ActiveCell.Rows("1:1").EntireRow.Select 

    Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 

    ColumnNumber = ActiveCell.Column 

    DataSheet.AutoFilterMode = False 
    DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria 

End If 

    ValidatorWB.Activate 
    PopDetail.Activate 

'x = x + 1 

Next x 

    DataWB.Activate 
    DataSheet.Activate 

    'Alpahebtical order 
    DataSheet.Range("A1").Select 
    ActiveCell.Rows("1:1").EntireRow.Select 
    Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _ 
    LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False).Activate 
    FNOrdCol = ActiveCell.Address 
    'DataWB.DataSheet.Sort.SortFields.Clear 
    DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _ 
     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 

    With DataWB.DataSheet.Sort 
     .SetRange DataSheet.Cells 
     .header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    'Copy data 
    Range("A1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 

    'Paste data to validator 
    ValidatorWB.Activate 
    ValidatorWB.Sheets.Add().Name = "ValidatorData" 
    ActiveCell.Offset(3, 0).Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=True 
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15 
    Application.CutCopyMode = False 

'DataWB.Close savechanges:=False 
If DataWB.Windows(1).Visible = True Then 
DataWB.Windows(1).Visible = False 
End If 

Application.ScreenUpdating = True 

PopDetail.Activate 

End If 

End Sub 

Answer 1

Если отладочная информация показывает, что переменная FNOrder правильно назначена, то это сокращенный вариант кода сортировки должен быть все, что вам требуется.

debug.print FNOrder & " is the name of the column to be sorted on" 
    With DataSheet 
     With .Cells(1, 1).CurrentRegion 
      .Cells.Sort Key1:=.Columns(Application.Match(FNOrder, .Rows(1), 0)), Order1:=xlAscending, _ 
         Orientation:=xlTopToBottom, Header:=xlYes 
      .Cells.Copy 
     End With 
    End With 

Если информационные листки было правильно определено, что вам не нужно указывать родительскую книгу.

В конце этого раздела кода данные должны быть отсортированы и «на буфере обмена». Вам все равно нужно добавить новый рабочий лист в книгу ValidatorWB и вставить значения.

Если это произойдет, проверьте окно Immediate VBE (например, Ctrl + G), чтобы узнать, что было сообщено как значение FNOrder.

Если вы заинтересованы в этом, я бы порекомендовал разместить его в Code Review (Excel) для советов по оптимизации.

Answer 2

Исправлено. Я изменил DataWB.DataSheet во всех ссылках только на ActiveSheet. Спасибо вам за помощь.