(Solved) – Copy only filtered data / visible cells from multiple sheets to new workbook

(solved)-–-copy-only-filtered-data-/-visible-cells-from-multiple-sheets-to-new-workbook

How do I copy only the filtered data from each worksheet (8 worksheets in total) to a new workbook? My filtered header varies for each worksheet, not necessary at from row.

I have posted two sets of codes here, any help / advice is appreciated, thanks!

  1. I wrote in a dumb way for filtering as for someone who has not much vba knowledge, I couldn’t think a better way to filter multiple sheets by country. I have to filter the country across 8 worksheets, and I have about 20 countries to filter, referencing to the country selected in dropdown list from another workbook. Below is the sample I did for one country.
Sub FilterByCountry()


'Referencing the country selected
If Workbooks("PAP_Macro_v1.xlsm").Worksheets("Export by country").Range("C3") = "Australia" Then

    'Filtering for each worksheet
        Workbooks("SFDC_2020-xx_(PAP)-WD.xlsx").Worksheets("Summary PAP").Range("A1:I1").AutoFilter _
        Field:=1, _
        Criteria1:="Australia", _
        VisibleDropDown:=True
End If

If Workbooks("PAP_Macro_v1.xlsm").Worksheets("Export by country").Range("C3") = "Australia" Then

        Workbooks("SFDC_2020-xx_(PAP)-WD.xlsx").Worksheets("PAP").Range("A6:BK6").AutoFilter _
        Field:=5, _
        Criteria1:="Australia", _
        VisibleDropDown:=True
End If

If Workbooks("PAP_Macro_v1.xlsm").Worksheets("Export by country").Range("C3") = "Australia" Then

        Workbooks("SFDC_2020-xx_(PAP)-WD.xlsx").Worksheets("PAP by Country").Range("B6:AV6").AutoFilter _
        Field:=2, _
        Criteria1:="Australia", _
        VisibleDropDown:=True
End If

If Workbooks("PAP_Macro_v1.xlsm").Worksheets("Export by country").Range("C3") = "Australia" Then

        Workbooks("SFDC_2020-xx_(PAP)-WD.xlsx").Worksheets("PAP Target").Range("A1:I1").AutoFilter _
        Field:=1, _
        Criteria1:="Australia", _
        VisibleDropDown:=True
End If

If Workbooks("PAP_Macro_v1.xlsm").Worksheets("Export by country").Range("C3") = "Australia" Then

        Workbooks("SFDC_2020-xx_(PAP)-WD.xlsx").Worksheets("Country Summary Month").Range("A4:AD4").AutoFilter _
        Field:=1, _
        Criteria1:="Australia", _
        VisibleDropDown:=True
End If

If Workbooks("PAP_Macro_v1.xlsm").Worksheets("Export by country").Range("C3") = "Australia" Then

        Workbooks("SFDC_2020-xx_(PAP)-WD.xlsx").Worksheets("Users Summary Month").Range("A5:AK5").AutoFilter _
        Field:=2, _
        Criteria1:="Australia", _
        VisibleDropDown:=True
End If

If Workbooks("PAP_Macro_v1.xlsm").Worksheets("Export by country").Range("C3") = "Australia" Then

        Workbooks("SFDC_2020-xx_(PAP)-WD.xlsx").Worksheets("Country Summary YTD").Range("A4:AG4").AutoFilter _
        Field:=1, _
        Criteria1:="Australia", _
        VisibleDropDown:=True
End If

If Workbooks("PAP_Macro_v1.xlsm").Worksheets("Export by country").Range("C3") = "Australia" Then

        Workbooks("SFDC_2020-xx_(PAP)-WD.xlsx").Worksheets("Users Summary YTD").Range("A5:AJ5").AutoFilter _
        Field:=2, _
        Criteria1:="Australia", _
        VisibleDropDown:=True
End If

End Sub

  1. I would like to copy the filtered data (visible cells) for all worksheets from one workbook to another. I tried to run below codes but it copies all data, including those which are hidden from the filter.
Sub exportS()

Dim NewName As String

Workbooks("SFDC_2020-xx_(PAP)-WD.xlsx").Worksheets(Array("BU TEC PAP history", "Summary PAP", "PAP", "PAP by Country", _
 "PAP Target", "Country Summary Month", "Users Summary Month", "Country Summary YTD", "Users Summary YTD")).Copy


NewName = InputBox("Please Specify the name of your new workbook", "Export by Country", "SFDC_2020-xx_(PAP)-[country]")

With ActiveWorkbook
     .SaveCopyAs ThisWorkbook.Path & "" & NewName & ".xlsx"
     .Close SaveChanges:=False
End With

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *