excel - 在 Excel VBA 中复制筛选的数据

Question

我有一些代码可以进行一些编辑然后过滤。然后我复制这些数据并粘贴到新工作表。问题是，行每次都会增长，所以我想让这个动态。
有人可以在这里指导我吗？
这是我正在工作的代码

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

我希望动态能够改变的部分是这部分:(有一天它可能是 300 行等)

 Range("A1:H169").Select
    Selection.Copy

Answer 1

如果您要从表中复制，请尝试替换 Range("A1:H169")引用表格的范围。

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