VBA 在合并文件之前清除过滤器

Question

我正在通过 VBA 进行电子表格自动化流程，到目前为止取得了成功，但我有点坚持其中的一个元素，即在复制之前清除过滤器。 此代码位于主文件的模块中，它的作用是打开文件夹中的每个工作簿（每个文件都有一个工作表），将所有数据从 A2 复制到 AJ（无论有多少行），将其粘贴到masterfile，然后关闭文件并移动到文件夹中的下一个，直到所有文件都合并到master中，在上一个的正下方有一个数据块。它完美地工作。问题在于，在某些情况下，这些文件可能具有过滤列，并且过滤掉的所有内容都不会被复制。这些文件是从另一个部门发送的。 我确实搜索了 SO 并找到了清除过滤器的不同方法，我什至尝试了一个单独工作的代码，但由于某种原因我无法让它们在我的代码上工作，也许我将它们放在错误的位置或某物？另外，我应该改变什么来清理/优化代码吗？

感谢您的时间和关注！

Option Explicit

Sub ExcelMerge()
    Dim wbkReports As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    Set dirObj = mergeObj.Getfolder("C:\Users\Report")
    Set filesObj = dirObj.Files
For Each everyObj In filesObj
    Set wbkReports = Workbooks.Open(everyObj)

    Range("A2:AJ" & Range("A65536").End(xlUp).Row).Copy

    ThisWorkbook.Worksheets(1).Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wbkReports.Close
Next

    AddFormulas

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub AddFormulas()
    Dim lastRow As Long, i As Long
    Dim ws As Worksheet

    Set ws = Sheets("Report")

    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

With ws
    For i = 10 To lastRow
        If Len(Trim(.Range("A" & i).Value)) <> 0 Then _
        .Range("AK" & i).FormulaR1C1 = "formula here"
        .Range("AL" & i).FormulaR1C1 = "formula here"
        .Range("AM" & i).FormulaR1C1 = "formula here"
    Next i
End With
End Sub

Answer 1

看看这个。此外，您应该定义您正在使用的工作表，而不是仅仅从Range("A2:AJ... 复制，因为这可能会导致从错误的工作表复制数据时出错。此外，如果您在关闭工作簿时添加SaveChanges:=False，您将阻止永久取消过滤范围

Sub ExcelMerge()
    Dim wbkReports As Workbook
    Dim ws As Worksheet
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    Set dirObj = mergeObj.Getfolder("C:\Users\Report")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set wbkReports = Workbooks.Open(everyObj)

        For Each ws In wbkReports.Worksheets
            If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
        Next ws

        Range("A2:AJ" & Range("A65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
        ' Include savechanges:=False to not save the unfiltering of sheets
        wbkReports.Close savechanges:=False
    Next

    AddFormulas

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub