excel - 使用 vba 从表格中删除过滤的单元格

Question

我有下面的代码，我想要完成的是:
删除所有过滤结果并创建一个没有过滤结果的新表。这段代码的问题在于，每次包含新工作表时，我都必须为其添加这行代码。有没有办法解决这个问题？我试过使用 For Each...Next 语句，但没有任何成功。
编辑:Sheet1、Sheet2 等是在宏的前面创建的，仅用于此目的。

Sub macro
  
  Worksheets("cat").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
    Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    Worksheets("Sheet1").Paste
    Worksheets("cat").Delete
    Worksheets("Sheet1").Name = "cat"
    
    
    Worksheets("dog").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
    Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    Worksheets("Sheet2").Paste
    Worksheets("dog").Delete
    Worksheets("Sheet2").Name = "dog"
    
    Worksheets("meow").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
    Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    Worksheets("Sheet3").Paste
    Worksheets("meow").Delete
    Worksheets("Sheet3").Name = "meow"
    
    
    Worksheets("bark").ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
    Worksheets("Sheet4").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    Worksheets("Sheet4").Paste
    Worksheets("bark").Delete
    Worksheets("Sheet4").Name = "bark"

End Sub

Answer 1

请尝试下一个代码:

Sub macroIterateSh()
   Dim sh As Worksheet, shNew As Worksheet, shName As String
   For Each sh In ActiveWorkbook.Sheets
        If sh.ListObjects.Count > 0 Then 'for the case of some other sheets not containing a list object...
            Set shNew = Worksheets.Add(Before:=sh)
            sh.ListObjects(1).Range.SpecialCells(xlCellTypeVisible).Copy
            shNew.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                                                                SkipBlanks:=False, Transpose:=False
            shNew.Paste
            shName = sh.Name: sh.Delete
            shNew.Name = shName
        End If
   Next
End Sub