Search code examples
excelvbaexcel-2019

Copy Filtered Data in Excel VBA


I have some code which does some editing and then filters. I then copy this data and paste to new sheet. Problem is, the rows can grow each time so i would like to make this dynamic.

Can anybody guide me here?

Here is my code which is working

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

The part i would like dynamic to be able to change is this part: (one day it might be 300 lines etc)

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

Solution

  • If you are copying from the table try replacing Range("A1:H169") with a reference to the table's range.

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