Excel VBA筛选单元格复制问题：代码报错且无法复制筛选值

一、语法错误修复要点 #

原代码存在多处结构不完整问题，导致编译报错，具体修复如下：

• 新增变量声明：添加Dim flag As Boolean，避免隐式变体变量引发的潜在问题
• 补全循环结构：为内层Do循环添加Loop，为For Each ws循环添加Next ws收尾
• 闭合条件块：匹配所有If对应的End If，以及With块的End With
• 规范跳转逻辑：调整GoTo的使用范围，避免破坏代码整体结构

二、筛选数据复制逻辑优化 #

原代码无法复制全部筛选后单元格，核心原因是未针对可见单元格操作，优化要点：

• 移除Select/Activate操作，直接通过工作表对象引用范围，提升代码稳定性与执行效率
• 使用SpecialCells(xlCellTypeVisible)仅复制筛选后的可见单元格，避免包含隐藏行数据
• 动态计算目标粘贴位置，确保数据追加到目标表的最后一行，避免覆盖或错位

修正后的完整代码 #

Sub Compile_SKU_Inventory_Summary()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim Vfile As Variant
    Dim wbto As Workbook
    Dim ws, wsfromwhs, WScompSKU As Worksheet ' 修正变量声明，每个变量单独指定类型
    Dim lrowpotab, lrowcom, lrow7 As Long
    Dim h As Integer
    Dim sheetname As String
    Dim flag As Boolean ' 新增变量声明

    Set wbto = ActiveWorkbook
    Set WScompSKU = wbto.Worksheets("Compile_SKU")

    ' 清空目标表数据（避免Select操作）
    With WScompSKU
        If .Cells(Rows.Count, 2).End(xlUp).Row >= 2 Then
            .Range("A2:B" & .Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
        End If
    End With

    Set wsfromwhs = wbto.Worksheets("WH_Split1")
    h = 2

    Do While wsfromwhs.Cells(1, h).Value <> "" ' 调整Do循环结构，逻辑更直观
        flag = False
        sheetname = "PO_Tab_" & wsfromwhs.Cells(1, h).Value

        ' 检查目标工作表是否存在
        For Each ws In wbto.Worksheets
            If ws.Name = sheetname Then
                flag = True
                Exit For ' 找到后退出循环，提升效率
            End If
        Next ws ' 补全For循环收尾

        If flag = True Then
            Set wsfromwhs = wbto.Worksheets(sheetname)
            wsfromwhs.Calculate
            
            Dim sourceRange As Range
            lrowpotab = wsfromwhs.Cells(Rows.Count, 1).End(xlUp).Row
            
            ' 应用筛选
            wsfromwhs.Range("A3:AM" & lrowpotab).AutoFilter Field:=39, Criteria1:=">0"
            
            lrow7 = wsfromwhs.Cells(Rows.Count, 1).End(xlUp).Row
            If lrow7 <= 2 Then ' 无有效数据时跳过
                wsfromwhs.AutoFilterMode = False
                h = h + 1
                GoTo NextLoop ' 跳转到循环末尾
            End If

            ' 定位筛选后的可见单元格，处理无可见单元格的异常
            On Error Resume Next
            Set sourceRange = wsfromwhs.Range("A3:A" & lrow7).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0

            If Not sourceRange Is Nothing Then
                ' 获取目标表最后一行，处理空表情况
                lrowcom = WScompSKU.Cells(Rows.Count, 2).End(xlUp).Row
                If lrowcom < 2 Then lrowcom = 1
                
                ' 复制可见单元格值到目标表
                sourceRange.Copy
                WScompSKU.Cells(lrowcom + 1, 2).PasteSpecial Paste:=xlPasteValues
            End If

            ' 关闭筛选
            wsfromwhs.AutoFilterMode = False
        End If

NextLoop:
        h = h + 1
    Loop ' 补全Do循环收尾

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

关键修改说明 #

1. 变量声明规范：原代码中多个变量未指定类型（仅最后一个变量有效），修正为每个变量明确类型，避免隐式类型转换错误
2. 冗余操作移除：删除不必要的Select/Activate，直接通过对象引用操作单元格，减少代码出错概率
3. 可见单元格处理：使用SpecialCells(xlCellTypeVisible)精准复制筛选后的数据，确保只复制可见行
4. 错误处理添加：新增On Error语句，处理筛选后无可见单元格的异常情况
5. 循环结构优化：调整Do循环为Do While，逻辑更直观，避免嵌套混乱

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