在循环文件以复制/粘贴到单个工作表时对活动工作表进行排序

Question

我正在使用下面的代码来尝试遍历文件夹中的大量 Excel 工作表。我希望代码打开文件，按字母顺序排序，然后进行自定义排序，然后将所有内容复制粘贴到新工作表中。就其本身而言，如果我在打开的工作表上运行它，排序就可以完美运行。但是，在下面的循环内部，没有任何排序，因为它将未排序的值粘贴到新工作表中。需要明确的是，将所有内容放在一张纸上的循环是有效的，排序部分是有效的。只有将它们放在一起时，排序才会停止。我认为问题在于我的代码正在尝试对 ThisWorkbook 进行排序，而不是对刚刚打开的工作表进行排序，尽管我不确定为什么。我对 VBA 非常陌生。

Sub MergeFiles()

Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")

Set dirObj = mergeObj.Getfolder("PATH")
Set filesObj = dirObj.Files
For Each everyObj In filesObj

Set bookList = Workbooks.Open(everyObj)

    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add _
        Key:=Range("A1:ER1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:ER195")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add _
        Key:=Range("A1:ER1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:="thing1,thing2,thing3", _
        DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:ER195")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

Range("A2:ES" & Range("A196").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

Range("A10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
bookList.Close
Next
End Sub

Answer 1

在我看来，您似乎依赖于 ActiveWorkbook 和 ActiveSheeet 持有的状态（和对象）。虽然打开工作簿通常会将其设为 ActiveWorkbook，但在 ThisWorkbook 和最近打开的工作簿之间跳转并不是理想的方法。

Sub MergeFiles()
    Dim bookList As Workbook, wb As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object

    On Error GoTo Fìn
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    Set wb = ThisWorkbook
    Set dirObj = mergeObj.Getfolder("PATH")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        If CBool(InStr(1, filsobj, ".xl", vbTextCompare)) Then
            Set bookList = Workbooks.Open(Filename:=everyObj, ReadOnly:=True)

            With bookList.Sheets(1).Cells(1, 1).Resize(195, 148)
                .Cells.Sort Key1:=.Rows(1), Order1:=xlAscending, _
                            Orientation:=xlLeftToRight, Header:=xlYes, MatchCase:=False, _
                            DataOption:=xlSortNormal
                .Cells.Sort Key1:=.Rows(1), Order1:=xlAscending, _
                            Orientation:=xlLeftToRight, Header:=xlYes, MatchCase:=False, _
                            DataOption:=xlSortNormal, CustomOrder:="thing1,thing2,thing3"
                wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(195, 149) = _
                  .Resize(195, 149).Values
            End With

            debug.print bookList.Name
            bookList.Close SaveChanges:=False
            Set bookList = Nothing
        End If
    Next everyObj
Fìn:
    Set mergeObj = Nothing
    Set wb = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

从 VBE 的即时窗口（又名Ctrl+G）中将提供已处理工作簿的列表。