Vba 跨工作簿中的多个工作表应用宏筛选，并将筛选后的值保存为包含这些多个工作表的另一个工作簿

我有一本包含23张工作表的工作簿。我必须应用宏自动筛选来筛选23个工作表中所需的数据，并将这些数据保存为工作手册，其中包含23个工作表中的筛选数据

     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 & "*"
     If s <> vbNullString Then

     For k = 1 To 20
     If (k <> 1) And (k <> 4) And (k <> 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

子开关_过滤器（）
尺寸j为整数，k为整数，k1为整数
Dim LastRow为整数，i为整数，erow为整数
尺寸s为变型，s1为变型
j=工作表。计数
s=输入框（“输入开关id”）
s1=s&“*”
如果是vbNullString，则
对于k=1到20
如果（k1）和（k4）和（k7），那么
带工作表（k）
.UsedRange.AutoFilter字段：=3，准则1:=s1
LastRow=.Cells（.Rows.Count，“A”）.End（xlUp）.Row
对于i=3到最后一行
范围（单元格（i，1），单元格（i，36））。选择
选择，复制
工作簿。打开文件名：=“C:\Users\takyar\Documents\salesmaster new.xlsx”
工作表（k）。选择
erow=ActiveSheet.Cells（Rows.Count，1）.End（xlUp）.Offset（1，0）.Row
单元格（erow，1）。选择
活动表。粘贴
活动工作簿。保存
活动工作簿。关闭
Application.CutCopyMode=False
接下来我
以
如果结束
下一个k
如果结束
端接头

几乎完成，但它将过滤后的数据保存在新工作簿的同一页中，我在此附上代码：-

     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 & "*"
     If s <> vbNullString Then

     For k = 1 To 20

     With Worksheets(k)
     Set MyWorkbook = ThisWorkbook
     If (k <> 1) And (k <> 4) And (k <> 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

子开关_过滤器（）
尺寸j为整数，k为整数
Dim LastRow为整数，i为整数
尺寸s为变型，s1为变型
将MyWorkbook设置为工作簿，将newWork设置为工作簿
设置MyWorkbook=ThisWorkbook
j=工作表。计数
s=输入框（“输入开关id”）
s1=s&“*”
如果是vbNullString，则
对于k=1到20
带工作表（k）
设置MyWorkbook=ThisWorkbook
如果（k1）和（k4）和（k7），那么
.AutoFilterMode=False
带工作表（k）。使用表格
.自动过滤器
.自动筛选字段：=3，标准1:=s1
以
如果结束
MyWorkbook.Sheets（k）.行（“1:65000”）.复制
设置newWork=Workbooks.Open（“E:\spreed sheet\sample1.xlsx”）
使用newWork.Worksheets（k）
范围（“A2”）。粘贴特殊粘贴：=xlPasteAll
新工作，结束
以
以
下一个k
如果结束
端接头

请给我一个解决方案

---

提前谢谢

甚至不确定这是否正在执行，您没有真正说明错误发生的位置

如果没有这些信息，我认为最大的问题是您一次复制一行，并且每次要复制该行时都要打开和关闭工作簿

如果您希望新工作簿只包含已筛选数据的所有单独的页，那么您可能需要考虑在旧文档中创建新的工作表，只需将已筛选的数据和剪切/移动到一个新的文档一次整页。您可以通过录制宏并手动执行来学习代码

否则，如果您可以将这些数据全部存储在一个工作表/表格中，我建议将每个工作表及其过滤数据加载到一个数组中，然后打开新工作簿并写入该数组中的所有信息。这个选项很可能是最快的。

最终得到了答案

      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
 Dim ws As Worksheet, ws1 As Worksheet

 Dim name As String



 Set MyWorkbook = ThisWorkbook

 j = Worksheets.Count

 s = InputBox("Enter Switch id")
 s1 = s & "*"
 If s <> vbNullString Then

 For k = 1 To j

 With Worksheets(k)

 Set MyWorkbook = ThisWorkbook
 '.UsedRange.AutoFilter Field:=3, Criteria1:=s1
    If (k <> 1) And (k <> 4) And (k <> 7) And (k < 20) Then

    .AutoFilterMode = False
        With Worksheets(k).UsedRange
            .AutoFilter
            .AutoFilter Field:=3, Criteria1:=s1
         End With
    End If
 'LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    MyWorkbook.Sheets(k).Rows("1:65000").Copy

    Set newWork = Workbooks.Open("E:\spreed sheet\sample1.xlsx")


    Set ws = Sheets.Add
    name = ws.name

    With newWork.Sheets(name)

        Range("A2").PasteSpecial Paste:=xlPasteAll

        newWork.Close

    End With

 End With
 Next k
 End If
 End Sub

子开关_过滤器（）
尺寸j为整数，k为整数
Dim LastRow为整数，i为整数
尺寸s为变型，s1为变型
将MyWorkbook设置为工作簿，将newWork设置为工作簿
将ws设置为工作表，将ws1设置为工作表
将名称设置为字符串
设置MyWorkbook=ThisWorkbook
j=工作表。计数
s=输入框（“输入开关id”）
s1=s&“*”
如果是vbNullString，则
对于k=1到j
带工作表（k）
设置MyWorkbook=ThisWorkbook
'.UsedRange.AutoFilter字段：=3，准则1:=s1
如果（k1）和（k4）和（k7）和（k<20），那么
.AutoFilterMode=False
带工作表（k）。使用表格
.自动过滤器
.自动筛选字段：=3，标准1:=s1
以
如果结束
'LastRow=.Cells（.Rows.Count，“A”）.End（xlUp）.Row
MyWorkbook.Sheets（k）.行（“1:65000”）.复制
设置newWork=Workbooks.Open（“E:\spreed sheet\sample1.xlsx”）
设置ws=Sheets.Add
name=ws.name
使用newWork.Sheets（名称）
范围（“A2”）。粘贴特殊粘贴：=xlPasteAll
新工作，结束
以
以
下一个k
如果结束
端接头

我必须应用宏…

那么是什么阻止了你呢？Siddharth Rout先生，我不知道宏的确切编码方法你知道如何用VBA编码吗？是的，有一点，有可能实现上述概念吗？？？是的，但我怀疑是否有人会把代码放在盘子里给你（除非有人想快速指出）。您必须编写自己的代码，然后在此处发布代码，说明您的具体位置。LastRow=.Cells（.Rows.Count，“A”）。End（xlUp）.行错误此行Archiassir先生，是否可以从工作表的第5行应用自动筛选，因为表格标题从第5行开始1ly