如何解决在 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,[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
解决方法
如果您要从表中复制,请尝试将 Range("A1:H169")
替换为对表范围的引用。
ActiveSheet.ListObjects("Table1").Range.Copy
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。