VBA筛选后仅复制表头未复制数据问题求助

1. GetTheLastRow函数参数未使用的隐患 #

函数定义了sheetName参数，但内部硬编码为"ALL"，后续若传入其他工作表名称会导致获取错误的最后行。修复如下：

Function GetTheLastRow(sheetName As String) As Long
    'Function to get last row in the sheet
    Dim sheetTarget As Worksheet
    Dim lastRow As Long
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Set sheetTarget = wb.Sheets(sheetName) ' 使用传入的参数
    lastRow = sheetTarget.Cells(sheetTarget.Rows.Count, 1).End(xlUp).Row
    GetTheLastRow = lastRow
End Function

2. AutoFilter范围错误（核心问题） #

当前代码将筛选范围设为A2:BL&lastRowSourceSheet，Excel会把A2当作表头行筛选，而实际数据表头应为A1、数据行从A2开始，这会导致筛选逻辑错误，甚至无匹配数据。

修复方式：将筛选范围改为包含表头的A1:BL&lastRowSourceSheet，同时修复#N/A的筛选条件：

' 替换原筛选代码
With Sheets(sourceSheet)
    .AutoFilterMode = False ' 清除原有筛选
    .Range("A1:BL" & lastRowSourceSheet).AutoFilter field:=57, Criteria1:="LOLOS SORTIR"
    .Range("A1:BL" & lastRowSourceSheet).AutoFilter field:=63, Criteria1:="New Batch"
    .Range("A1:BL" & lastRowSourceSheet).AutoFilter field:=64, Criteria1:="=NA()"
End With

3. #N/A筛选条件错误 #

若单元格是公式返回的#N/A错误值，Criteria1:="#N/A"无法匹配（仅能匹配文本内容为#N/A的单元格），需改为Criteria1:="=NA()"精准匹配公式返回的#N/A；若需匹配所有错误值，可改用Criteria1:=xlFilterErrors。

4. 复制范围的容错处理 #

筛选后无可见数据时，SpecialCells(xlCellTypeVisible)会报错，需添加错误处理：

On Error Resume Next
Sheets(sourceSheet).Range("C2:BE" & lastRowSourceSheet).SpecialCells(xlCellTypeVisible).Copy
If Err.Number <> 0 Then
    MsgBox "没有符合条件的数据可复制！"
    Sheets(sourceSheet).AutoFilterMode = False ' 清除筛选
    Exit Sub
End If
On Error GoTo 0

完整修复后的代码 #

Function GetTheLastRow(sheetName As String) As Long
    'Function to get last row in the sheet
    Dim sheetTarget As Worksheet
    Dim lastRow As Long
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Set sheetTarget = wb.Sheets(sheetName)
    lastRow = sheetTarget.Cells(sheetTarget.Rows.Count, 1).End(xlUp).Row
    GetTheLastRow = lastRow
End Function

Sub ExportASI()
    Dim sourceSheet As String, targetSheet As String
    Dim lastRowSourceSheet As Long
    Dim wb As Workbook
    
    Set wb = ThisWorkbook
    sourceSheet = "ALL"
    targetSheet = "BATCH"
    
    lastRowSourceSheet = GetTheLastRow(sourceSheet)
    
    ' 应用筛选（修复范围和#N/A条件）
    With Sheets(sourceSheet)
        .AutoFilterMode = False ' 清除原有筛选
        .Range("A1:BL" & lastRowSourceSheet).AutoFilter field:=57, Criteria1:="LOLOS SORTIR"
        .Range("A1:BL" & lastRowSourceSheet).AutoFilter field:=63, Criteria1:="New Batch"
        .Range("A1:BL" & lastRowSourceSheet).AutoFilter field:=64, Criteria1:="=NA()"
    End With
    
    ' 复制可见数据，添加容错
    On Error Resume Next
    Sheets(sourceSheet).Range("C2:BE" & lastRowSourceSheet).SpecialCells(xlCellTypeVisible).Copy
    If Err.Number <> 0 Then
        MsgBox "没有符合条件的数据可导出！"
        Sheets(sourceSheet).AutoFilterMode = False ' 清除筛选
        Exit Sub
    End If
    On Error GoTo 0
    
    Sheets(targetSheet).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
    
    'Export sheet BATCH
    Dim fName
    Sheets("BATCH").Copy
    With ActiveSheet
        .UsedRange.Copy
        .Cells(1, 1).PasteSpecial xlPasteValues
        .Cells(1, 1).PasteSpecial xlPasteFormats
    End With
    Application.CutCopyMode = False
    
    fName = Application.GetSaveAsFilename(InitialFileName:="", Filefilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As")
    If fName <> False Then ' 取消保存时不执行后续操作
        With ActiveWorkbook
            .SaveAs Filename:=fName
            .Close True
        End With
    Else
        ActiveWorkbook.Close False ' 关闭未保存的工作簿
    End If
    
    ' 清除原表的筛选
    Sheets(sourceSheet).AutoFilterMode = False
End Sub

额外注意事项 #

• 确认列号（field:=57、63、64）是从A1开始计数的正确列，避免插入/删除列导致列号偏移。
• 若#N/A为文本类型而非错误值，可改回Criteria1:="#N/A"。
• 每次运行前清除原有筛选，避免叠加筛选导致结果异常。

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