将已过滤的数据从多个工作表复制到一个工作表中

Question

我目前正在处理一个宏，该宏会检查工作簿中是否有名为“组合”的工作表，如果它不存在，它会创建一个宏，然后检查其他工作表是否已自动筛选，如果已关闭，则将其关闭并打开并进行筛选根据我的需要。

然后，我需要将数据从工作簿中的每个工作表复制到工作表中。但是，当工作表被筛选并且由于其为空时，宏将复制它不应该复制的内容。

Sub Combine()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "x" And ws.Name <> "y" And ws.Name <> "z" _
            And ws.Name <> "q" Then

        If ws.Name = "Combined" Then
            Application.DisplayAlerts = False
            Sheets("Combined").Delete
            Application.DisplayAlerts = True
            GoTo there
        End If

        If ws.ListObjects(1).ShowAutoFilter Then
            ws.ListObjects(1).Range.AutoFilter
            ws.ListObjects(1).Range.AutoFilter
        Else
            ws.ListObjects(1).Range.AutoFilter
        End If

        ws.UsedRange.AutoFilter Field:=10, Criteria1:="=Item"
        ws.UsedRange.AutoFilter Field:=3, Criteria1:=8, Operator:=11, _
            Criteria2:=0, SubField:=0

        End If
there:
    Next

    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Combined"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "x" And ws.Name <> "y" And ws.Name <> "z" _
                            And ws.Name <> "q" And ws.Name <> "Combined" Then
            ws.Activate
            Range("A1").Select
            Selection.CurrentRegion.Select
            Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
            Selection.Copy Destination:=Sheets(1).Range("A1000000").End(xlUp)(2)
        End If
    Next
End Sub

Answer 1

帖子Excel Filtering and Copying in VBA应该可以帮助您。