Excel VBA 实现筛选后数据动态复制功能的问题咨询

核心修改点 #

你需要替换的硬编码复制逻辑如下：

原代码（硬编码行号） #

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

修改后代码（动态适配行数） #

With ActiveSheet
    ' 动态获取H列最后一行有数据的行号
    Dim lRealLastRow As Long
    lRealLastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
    ' 拼接动态范围直接复制，无需选中单元格
    .Range("A1:H" & lRealLastRow).Copy
End With

可选优化 #

你原代码中大量使用Select、Selection操作会降低运行效率，也容易出现激活页错位的问题，可将后续新建表粘贴的逻辑同步优化：

' 删除原有的复制、新建表、粘贴相关代码，替换为以下逻辑
With Sheets("ZAF VCS Daily MU Close Time")
    Dim lRealLastRow As Long
    lRealLastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
    .Range("A1:H" & lRealLastRow).Copy
End With
' 新建工作表并粘贴
Dim newWs As Worksheet
Set newWs = Sheets.Add
newWs.Name = "data"
newWs.Range("A1").PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False

实现说明 #

• 通过Cells(行总数, 列号).End(xlUp).Row的写法可以自动定位到指定列最后一个有内容的行，完全适配后续数据行数增长的需求
• 无需提前预设最大行号，也不会因为数据行数减少复制多余空行

内容的提问来源于stack exchange，提问作者Lalaland