Excel VBA筛选后数据无法复制到新工作表仅生成空白文件问题求助

问题原因 #

你原代码存在4个核心错误导致筛选后数据无法正常粘贴：

• 新工作簿工作表名称引用错误：新建空白工作簿默认只有Sheet1工作表，你代码中尝试粘贴到不存在的UBI Bank工作表，后续命名时的大小写不统一也会引发引用错误
• 自动筛选参数缺失：多值筛选必须指定Operator:=xlFilterValues参数，否则筛选规则不生效
• 范围选择逻辑错误：使用xlDown、xlToRight配合选中的方式，在无符合筛选条件的行时会选中无效空范围，大量使用Select/Activate也极易引发上下文错位
• 数据范围不匹配：表头复制A~M列，筛选数据选到了W列，列范围不一致

修复后完整代码 #

Sub selfcopy()
    Dim exclfile As String
    Dim fdObj As Object
    Dim year As String
    Dim month As String
    Dim filterRng As Range
    Dim Newbook As Workbook
    Dim dataSht As Worksheet
    
    ' 赋值基础参数
    year = ThisWorkbook.Sheets("Menu").Range("e4").Text
    month = ThisWorkbook.Sheets("Menu").Range("e6").Text
    Set dataSht = ThisWorkbook.Worksheets("Final Salary")
    exclfile = "Salary File" & "-" & month
    
    ' 创建目标文件夹
    Application.ScreenUpdating = False
    Set fdObj = CreateObject("Scripting.FileSystemObject")
    Dim folderPath As String
    folderPath = "\\Account\e\SATYA\BANK\1-SALARY SHEET\1-TRANSFER\" & year & "\" & month
    If Not fdObj.FolderExists(folderPath) Then fdObj.CreateFolder folderPath
    Application.ScreenUpdating = True
    
    ' 新建工作簿并重命名工作表
    Set Newbook = Workbooks.Add
    Newbook.Worksheets(1).Name = "Salaryoutput"
    
    ' 复制表头（含图片）
    dataSht.Range("A1:M1").Copy Newbook.Worksheets("Salaryoutput").Range("A1")
    
    ' 执行筛选
    dataSht.Range("$A$2:$W$99999").AutoFilter Field:=1, Criteria1:=Array("1", month), Operator:=xlFilterValues
    
    ' 仅复制筛选后的可见行（排除表头）
    On Error Resume Next ' 防止无符合条件数据时报错
    Set filterRng = dataSht.Range("A2:M99999").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not filterRng Is Nothing Then
        filterRng.Copy Newbook.Worksheets("Salaryoutput").Range("A2")
    End If
    
    ' 清除筛选、保存文件
    dataSht.AutoFilterMode = False ' 复原原表筛选状态
    Application.CutCopyMode = False
    Newbook.SaveAs Filename:=folderPath & "\" & exclfile
    ' 可选配置：如果不需要保留生成的文件打开状态，可取消下一行注释
    ' Newbook.Close False
    
    ThisWorkbook.Worksheets("Menu").Select
    MsgBox "Excel has been saved to Bank Folder"
End Sub

关键调整说明 #

• 完全移除了Select/Activate写法，直接通过工作表对象引用操作，避免上下文错位
• 补充了多值筛选必须的Operator:=xlFilterValues参数，确保筛选规则生效
• 增加了无符合筛选条件数据的容错处理，避免代码报错
• 统一了数据范围为A~M列，和表头范围匹配
• 新增操作完成后复原原工作表筛选状态的逻辑，不影响原文件使用

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