请求协助完善VBA代码：实现VLOOKUP、筛选并复制数据至新工作表

我帮你把这段VBA代码补全并优化了，不仅实现了你需要的VLOOKUP功能，还完成了数据筛选和复制到新工作表的操作，同时去掉了原代码里冗余的Select操作，让代码更稳定高效。直接看完整代码：

Sub NAAgingPaste()
    ' 关闭屏幕刷新，提升运行速度并避免界面闪烁
    Application.ScreenUpdating = False
    
    Dim wsSource As Worksheet
    Set wsSource = ActiveSheet ' 将当前活动工作表设为数据源
    
    ' --- 1. 写入VLOOKUP公式并自动填充整列 ---
    ' 给T列添加表头
    wsSource.Range("T1").Value = "匹配结果"
    ' 获取S列最后一行有数据的行号，避免手动指定范围
    Dim lastRow As Long
    lastRow = wsSource.Cells(wsSource.Rows.Count, "S").End(xlUp).Row
    ' 写入VLOOKUP公式（可根据实际需求修改参数）
    ' 公式说明：查找当前行S列的值，在"数据对照表"的A-B列范围，返回第2列的值，精确匹配
    wsSource.Range("T2:T" & lastRow).FormulaR1C1 = _
        "=VLOOKUP(RC[-1], 数据对照表!C1:C2, 2, FALSE)"
    
    ' 自动调整S列宽度，方便查看数据
    wsSource.Columns("S:S").EntireColumn.AutoFit
    
    ' --- 2. 筛选数据 ---
    ' 以S-T列的表头为筛选区域，筛选T列不为空的记录（可修改Criteria1为你的目标条件）
    wsSource.Range("S1:T1").AutoFilter Field:=2, Criteria1:="<>"
    
    ' --- 3. 创建新工作表并复制筛选后的数据 ---
    Dim wsNew As Worksheet
    ' 在当前工作簿末尾添加新工作表
    Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsNew.Name = "NA Aging筛选结果" ' 给新工作表自定义命名
    
    ' 复制筛选后的可见数据（包含表头），只粘贴值和格式，避免公式引用错误
    wsSource.Range("S1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
    wsNew.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    ' 取消原工作表的筛选状态
    wsSource.AutoFilterMode = False
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
    
    ' 弹出提示告知操作完成
    MsgBox "所有操作已完成！筛选结果已保存到新工作表。"
End Sub

关键调整说明： #

• 移除了原代码中不必要的Select和ScrollColumn操作，直接操作工作表和单元格对象，代码更简洁稳定
• 自动识别数据的最后一行，无需手动指定公式填充范围
• VLOOKUP参数可灵活修改：
  • 把数据对照表!C1:C2替换为你的实际查找数据源范围
  • 把2改成你需要返回的列序号
  • 把FALSE改为TRUE如果需要近似匹配
• 筛选条件可自定义，比如要筛选T列等于特定值，将Criteria1:="<>"改为Criteria1:="目标值"即可
• 复制时选择粘贴值和格式，避免新工作表中的公式出现引用失效问题

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