在Excel VBA中复制筛选的数据

我有一些代码，可以进行编辑，然后过滤。然后我复制这些数据并粘贴到新的工作表上。问题是，行每次都会增长，所以我想让它成为动态的

有人能带我到这里吗

这是我正在工作的代码

Sub TTC_Test()
'
' TTC_Test Macro
'
Dim WS As Worksheet
Dim iBottomRow As Long, iRow As Long
Dim Tbl As ListObject

    Dim rng As Range
    Dim Ash As Worksheet
    Dim Cws As Worksheet
    Dim Rcount As Long
    Dim Rnum As Long
    Dim FilterRange As Range
    Dim FieldNum As Integer
    Dim count_row, count_col As Integer
    Dim tableListObj As ListObject
    Dim TblRng As Range



    Rows("1:2").Select
    Range("A2").Activate
    Selection.Delete Shift:=xlUp
    Range("F1").Select
    Selection.Copy
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Seconds"
    Range("A1").Select
    Application.CutCopyMode = False
    
        With Sheets("ZAF VCS Daily MU Close Time")
            
        'Find Last Row
        lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        'Find Last Column
        lLastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        'Range to create table
        Set TblRng = .Range("A1", .Cells(lLastRow, lLastColumn))
        
        'Create table in above specified range
        Set tableListObj = .ListObjects.Add(xlSrcRange, TblRng, , xlYes)
        
        'Specifying table name
        tableListObj.Name = "Table1"
        
        'Specify table style
        tableListObj.TableStyle = "TableStyleMedium14"
    End With
    

    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Table1[[#Headers],[Column2]]").Select
    ActiveCell.FormulaR1C1 = "Name"
    Range("Table1[[#Headers],[Column1]]").Select
    ActiveCell.FormulaR1C1 = "Email"
    Range("B2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=[@Agent]"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=[@Agent]&""@email.com"""
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Table1[[#Headers],[Column1]]").Select
    ActiveCell.FormulaR1C1 = "Time in Minutes"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=IF([@Seconds]<120,"""",[@Seconds]/60)"
    Range("J2").Select
    
    Set Tbl = ActiveWorkbook.Worksheets("ZAF VCS Daily MU Close Time").ListObjects("Table1")
ActiveCell.AutoFilter Field:=10, Criteria1:="<120"
Tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
ActiveWorkbook.Worksheets("ZAF VCS Daily MU Close Time").ListObjects("Table1").Range.AutoFilter Field:=10

    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=10
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = True
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=5, Criteria1:= _
        "namehere"
    Range("A1:H169").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-18
    Sheets.Add.Name = "data"
    Range("A1").Select
    ActiveSheet.Paste

End Sub

---

如果要从表中复制，请尝试将

范围（“A1:H169”）

替换为对表范围的引用

ActiveSheet.ListObjects("Table1").Range.Copy

---

我真不敢相信我竟然没想到那一点。非常感谢你，效果很好。

ActiveSheet.ListObjects("Table1").Range.Copy