title: Copy only filtered data / visible cells from multiple sheets to new workbook
body: <p>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.</p>
  
  <p>I have posted two sets of codes here, any help / advice is appreciated, thanks!</p>
  
  <ol>
  <li>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. </li>
  </ol>
  
  <pre><code>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
  
  </code></pre>
  
  <ol start="2">
  <li>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.</li>
  </ol>
  
  <pre><code>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 &amp; "\" &amp; NewName &amp; ".xlsx"
       .Close SaveChanges:=False
  End With
  
  End Sub
  </code></pre>