VBA unfilter each sheet in workbook-CodePudding

I have a workbook with filtered ranges on each sheet. I have tried a couple different methods but when stepping through it only does the first sheet or none at all. This is what I have tried.

dim ws as worksheet
For Each Ws In ThisWorkbook.Worksheets
    If Ws.AutoFilterMode Then
        Ws.AutoFilter.ShowAllData
    End If
    Next Ws

this one isn't doing anything at all

this one is less sophisticated and not what I want.

For Each ws In ThisWorkbook.Worksheets
        Rows("1:1").Select
        Selection.AutoFilter
Next ws

this is only doing the first worksheet and not moving to the next.
this is the full code and it is not returning any errors

    Sub Cleanup()
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Dim mergedWb As Workbook
    Set mergedWb = Workbooks.Add()
    
    Dim FolderPath As String
    Dim Filename As String
    Dim Sheet As Worksheet
    Dim ws As Worksheet
    
    
    Application.ScreenUpdating = False
    
    FolderPath = "<folder path>"
    
    
    
    Filename = Dir(FolderPath & "*.xls*")
    
    Do While Filename <> ""
        Dim wb As Workbook
        Set wb = Workbooks.Open(Filename:=FolderPath & Filename, ReadOnly:=True)
     
        For Each Sheet In wb.Sheets
           Sheet.Copy After:=mergedWb.Sheets(1)
        Next Sheet
     
        wb.Close
        Filename = Dir()
    Loop
    
    Sheets(1).Delete
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.AutoFilterMode Then
            ws.AutoFilter.ShowAllData
        End If
        Next ws
    
    
    End Sub

CodePudding user response：

Copy Sheets to New Workbook

Issues

ThisWorkbook is the workbook containing this code. It has nothing to do with the code so far: you're adding a new (destination) workbook (mergedWb) and you're opening (source) files ('wb') whose sheets (Sheet) will be copied. Instead, you should use:
```
For Each ws In mergedWb.Worksheets
```
When you use the Sheets collection, you need to keep in mind that it also includes charts. Therefore, you should declare:
```
Dim Sheet As Object
```

You need to qualify the first destination (work)sheet to ensure the correct worksheet is deleted:

Application.DisplayAlerts = False ' delete without confirmation
    mergedWb.Sheets(1).Delete
Application.DisplayAlerts = True

To turn off the auto filter, you need to use:
```
dws.AutoFilterMode = False
```
You can avoid the loop by copying all sheets (that are not very hidden) at once (per workbook):
```
swb.Sheets.Copy After...
```
The line swb.Sheets.Copy (no arguments) copies all sheets (that are not very hidden) to a new workbook.

The Code

Option Explicit

Sub Cleanup()

    Const SOURCE_FOLDER_PATH As String = "C:\Test"
    Const SOURCE_FILE_PATTERN As String = "*.xls*"

    If Not CreateObject("Scripting.FileSystemObject") _
            .FolderExists(SOURCE_FOLDER_PATH) Then
        MsgBox "The folder '" & SOURCE_FOLDER_PATH & "' doesn't exist.", _
            vbCritical
        Exit Sub
    End If
    
    Dim sFolderPath As String: sFolderPath = SOURCE_FOLDER_PATH
    If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"
    
    Dim sFileName As String: sFileName = Dir(sFolderPath & SOURCE_FILE_PATTERN)
    If Len(sFileName) = 0 Then
        MsgBox "No files found."
        Exit Sub
    End If

    Dim swb As Workbook
    Dim dwb As Workbook
    Dim sFilePath As String
    Dim IsNotFirstSourceWorkbook As Boolean

    Application.ScreenUpdating = False

    Do While Len(sFileName) > 0
        sFilePath = sFolderPath & sFileName

        Set swb = Workbooks.Open(Filename:=sFilePath, ReadOnly:=True)

        If IsNotFirstSourceWorkbook Then
            swb.Sheets.Copy After:=dwb.Sheets(dwb.Sheets.Count)
        Else
            swb.Sheets.Copy ' creates a new workbook containing the sheets
            Set dwb = Workbooks(Workbooks.Count)
            IsNotFirstSourceWorkbook = True
        End If

        swb.Close SaveChanges:=False

        sFileName = Dir()
    Loop

    Dim dws As Worksheet

    For Each dws In dwb.Worksheets
        If dws.AutoFilterMode Then dws.AutoFilterMode = False
    Next dws

    ' Decide what to do with the new workbook e.g.:
'    Application.DisplayAlerts = False ' overwrite without confirmation
'        dwb.SaveAs sFolderPath & "CleanUp " & Format(Date, "yyyymmdd")
'    Application.DisplayAlerts = True
'    dwb.Close SaveChanges:=False ' it has just been saved

    Application.ScreenUpdating = True
    
    MsgBox "Cleaned up.", vbInformation

End Sub