Excel 循环文件以复制/粘贴到单个图纸时，对活动图纸进行排序

我正在使用下面的代码尝试循环浏览文件夹中的大量excel工作表。我希望代码打开文件，按字母顺序排序，然后进行自定义排序，然后将所有内容复制粘贴到新工作表。就其本身而言，如果我在我打开的一张纸上运行排序，它就可以完美地工作。但是，在下面的循环中，没有排序，因为它将未排序的值粘贴到新工作表中。需要明确的是，将所有内容放在一张纸上的循环是有效的，排序部分也是有效的。只有把它们放在一起，这种事情才会停止。我认为问题在于我的代码试图对工作簿进行排序，而不是对刚刚打开的工作表进行排序，尽管我不知道为什么。我对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

---

在我看来，您似乎依赖于

ActiveWorkbook

和

activesheet

所持有的状态（和对象）。打开工作簿通常会使其成为

活动工作簿

，但在

此工作簿

和最近打开的工作簿之间跳转并不是理想的方法

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

）中将提供已处理工作簿的列表。

A）是否需要Excel来猜测是否有标题？在循环中肯定是

xlYes

还是

xlNo

？b） 您能确认您想要排序

xlleftoright

而不是

xltoptobttom

？我只问后者，因为它几乎从未被使用过。c）

A1:ER195

是静态区域还是或多或少取决于工作簿/工作表？d） 您使用工作簿中的哪个工作表作为源？第一张？谢谢你，吉普。是的，我确实需要它是左向右的，但是标题可以是否。是的，这是一个静态区域，我从中拉出，我只需要一张纸（1）。事实上，只要看看你的建议并对书目进行排序，Sheets（1）而不是ActiveSheet就解决了我的问题。