Question

我有一个包含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

几乎已完成，但它将过滤后的数据保存在新工作簿的同一张表中，这里我附上了代码： -

     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

请给我一个解决方案。

先谢谢你...... !!!

Answer 1

甚至不确定这是否正在执行，你并没有真正说出你的错误发生在哪里。

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

如果您希望新工作簿仅包含已过滤数据的所有单独工作表，那么您可能需要考虑在旧文档中仅使用过滤后的数据创建新工作表，并将其切换/移动到新文档整张表一次。 - 这是你可以通过录制宏并手动完成代码来学习代码的。

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

Answer 2

终于得到了答案

      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

在工作簿中的多个工作表中应用宏过滤器，并将过滤后的值另存为包含这些多个工作表的另一个工作簿

2 个答案: