excel - 在 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
我希望动态能够改变的部分是这部分:(有一天它可能是 300 行等)
Range("A1:H169").Select
Selection.Copy
解决方案
如果您要从表中复制,请尝试替换Range("A1:H169")
为对表范围的引用。
ActiveSheet.ListObjects("Table1").Range.Copy
推荐阅读
- javascript - 将数组数据转换为日期时间格式
- wordpress - 为什么我的数据库查询代码在 PHP 7.3 中失败?但它在 php7.0 中运行良好
- javascript - Echart图形不变色
- mysql - 增强对具有数百万条记录的表的不同查询
- pandas - pandas pivot_table:我可以在输出中显示小计吗?
- c - 如何从指针中减去字符数组?
- javascript - 谷歌表格脚本自动定位具有今天日期的单元格,复制整行并通过电子邮件发送
- c++ - 在自定义 ComboBox 中绘制文本
- flutter - 将列表中的颜色传递给小部件 - Flutter
- excel - 在 Excel VBA 中正确编写公式