title: Apply macro filter across Multiple worksheet in a workbook and and save the filtered value as another workbook containing those multiple sheet
body: <p>I have a workbook containing 23 work sheets. I have to apply Macro auto-filter to filter required data from the 23 work sheets and save those data as a work book with filtered data in those 23 work sheets..</p>
  
  <pre><code>     Sub Switch_Filter()
       Dim j As Integer, k As Integer, k1 As Integer
       Dim LastRow As Integer, i As Integer, erow As Integer
       Dim s As Variant, s1 As Variant
  
  
       j = Worksheets.Count
  
  
       s = InputBox("Enter Switch id")
       s1 = s &amp; "*"
       If s &lt;&gt; vbNullString Then
  
       For k = 1 To 20
       If (k &lt;&gt; 1) And (k &lt;&gt; 4) And (k &lt;&gt; 7) Then
       With Worksheets(k)
       .UsedRange.AutoFilter field:=3, Criteria1:=s1
  
  
       LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  
       For i = 3 To LastRow
  
  
       Range(Cells(i, 1), Cells(i, 36)).Select
       Selection.Copy
       Workbooks.Open Filename:="C:\Users\takyar\Documents\salesmaster-new.xlsx"
       Worksheets(k).Select
       erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  
       ActiveSheet.Cells(erow, 1).Select
       ActiveSheet.Paste
       ActiveWorkbook.Save
       ActiveWorkbook.Close
       Application.CutCopyMode = False
  
  
       Next i
  
       End With
  
       End If
       Next k
       End If
       End Sub
  </code></pre>
  
  <p>Almost Completed, but it save's the filtered data in the same sheet of the new workbook,here i have attached the code:-</p>
  
  <pre><code>     Sub Switch_Filter()
       Dim j As Integer, k As Integer
       Dim LastRow As Integer, i As Integer
       Dim s As Variant, s1 As Variant
       Dim MyWorkbook As Workbook, newWork As Workbook
       Set MyWorkbook = ThisWorkbook
  
       j = Worksheets.Count
  
       s = InputBox("Enter Switch id")
       s1 = s &amp; "*"
       If s &lt;&gt; vbNullString Then
  
       For k = 1 To 20
  
       With Worksheets(k)
       Set MyWorkbook = ThisWorkbook
       If (k &lt;&gt; 1) And (k &lt;&gt; 4) And (k &lt;&gt; 7) Then
  
      .AutoFilterMode = False
          With Worksheets(k).UsedRange
              .AutoFilter
              .AutoFilter Field:=3, Criteria1:=s1
           End With
      End If
  
      MyWorkbook.Sheets(k).Rows("1:65000").Copy
  
      Set newWork = Workbooks.Open("E:\spreed sheet\sample1.xlsx")
      With newWork.Worksheets(k)
          Range("A2").PasteSpecial Paste:=xlPasteAll
  
          newWork.Close
  
      End With
  
      End With
      Next k
      End If
      End Sub
  </code></pre>
  
  <p>pls suggest me a solution.</p>
  
  <p>Thanks in Advance....!!!</p>