在 Excel VBA 中复制过滤后的数据

Question

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

有人可以指导我吗？

这是我正在运行的代码

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

我希望 dynamic 能够更改的部分是这部分：（有一天它可能是 300 行等）

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

Answer 1

如果您是从 table 复制，请尝试将 Range("A1:H169") 替换为对 table 范围的引用。

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

在 Excel VBA 中复制过滤后的数据

Copy Filtered Data in Excel VBA

excel

vba

excel-2019