VBA to loop filter through sheets and export data column to new worksheet

[MikeyT_SE]

Hello friends! I am trying to create a macro and hitting some walls. The goal is to:

• Loop through worksheets (# of sheets may vary)
  • Filter Column D for "Equipment" and "Grid"
  • Take resulting data from Column A on each worksheet (excluding header) and paste to a new worksheet or workbook
    • End result would be a CSV list of Column A results from all worksheets, duplicates removed

The challenge I'm facing is looping through sheets until the end, so the macro would work whether there were 2 worksheets vs 10 worksheets, and output a single CSV with all results...

Your help and wisdom are appreciated!

 

[kevin9999]

There’s some detail missing from your question, such as:

• Do you want the code to be located in the workbook that contains all the sheets you want to filter/copy?
• Are “Equipment” and “Grid” the only words within the cells in column D or are they within strings?
• Are your headers on row 1 & does your data start in row 2?
• Do you want your new CSV to have headers?
• Do you want the new CSV saved to the same folder as the original data file?
• What do you want the new CSV file to be called?

I’ve made the following assumptions in the suggested code below:

• You want the code located in the file that contains the original data
• Your headers are in row 1 and your data starts in row 2
• Your new CSV doesn’t have headers
• You want the new CSV saved in the same folder as the original data file, and
• I’ve used a generic name for the new file

You can change all these variables to suit your particular case.

Option Explicit
Sub MikeyT()
    Application.ScreenUpdating = False
    Dim wb1 As Workbook, wb2 As Workbook
    Dim wsrc As Worksheet, wdest As Worksheet
    Dim lr As Long, i As Long
    
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks.Add(1)
    Set wdest = wb2.Worksheets(1)
    lr = wdest.Cells(Rows.Count, 1).End(3).Row + 1
    If lr = 2 Then lr = 1
    
    For i = 1 To wb1.Worksheets.Count
        With wb1.Worksheets(i).Cells(1, 1).CurrentRegion
            .AutoFilter 4, "Equipment", 2, "Grid"
            .Offset(1).Copy wdest.Cells(lr, 1)
            .AutoFilter
            lr = wdest.Cells(Rows.Count, 1).End(3).Row + 1
        End With
    Next i
    
    wb2.SaveAs ThisWorkbook.Path & "\New CSV File.csv", FileFormat:=6
    Application.ScreenUpdating = True
End Sub