VBA代码无报错但筛选数据复制后插入失效问题求助

从你的描述和代码来看，核心问题大概率出在不连续可见单元格的复制插入逻辑，以及目标位置计算的潜在歧义上。之前能正常运行突然失效，可能是因为数据结构变化（比如筛选后可见区域变成不连续），或者目标工作表的行号计算出现了偏差。

关键问题分析 #

1. 未限定工作表的Range引用：Debug.Print Range(...)这里没有指定wbk.Sheets("Acc")，如果运行时活动工作表不是目标表，会导致错误的范围输出，虽然你看到了地址，但可能复制的范围其实不对。
2. 不连续范围直接Insert的不稳定：筛选后的SpecialCells(xlCellTypeVisible)通常是不连续区域，直接用Insert粘贴这种区域容易出现内容丢失，因为Excel对不连续区域的插入粘贴支持有限。
3. 目标位置计算冗余且易出错：Offset((lastrow_Offset + 1) - 26, 0)的写法绕了弯路，容易因为lastrow_Offset的数值变化导致定位错误。

修改后的代码 #

Const sFILE_PATH As String = "C:\Downloads\"
Const sEXTENSION As String = ".xlsm"
Dim lastrow As Long
Dim lastrow_Offset As Long
Dim wbk As Workbook
Dim sFileName As String
Dim copyRange As Range

sFileName = "2018"
Set wbk = Workbooks(sFileName & sEXTENSION)

' 计算目标工作表H列最后一行（简化写法，更直观）
lastrow_Offset = ThisWorkbook.Sheets("Test").Cells(Rows.Count, "H").End(xlUp).Row
' 计算源工作表C列最后一行
lastrow = wbk.Sheets("Acc").Cells(Rows.Count, "C").End(xlUp).Row

Application.ScreenUpdating = False
With wbk.Sheets("Acc")
    .AutoFilterMode = False
    ' 应用双重筛选
    .Range("A4:AL" & lastrow).AutoFilter Field:=37, Criteria1:="=NC"
    .Range("A4:AL" & lastrow).AutoFilter Field:=38, Criteria1:="=New"
    
    ' 明确指定工作表，获取可见单元格范围（错误处理：避免无可见单元格时崩溃）
    On Error Resume Next
    Set copyRange = .Range("C5:C" & lastrow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not copyRange Is Nothing Then
        Debug.Print copyRange.Address ' 现在是正确的源工作表范围
        ' 先在目标位置插入对应数量的行（匹配复制的单元格数量）
        ThisWorkbook.Sheets("Test").Cells(lastrow_Offset + 1, "H").Resize(copyRange.Cells.Count).Insert Shift:=xlDown
        ' 再粘贴内容（用PasteSpecial确保内容正确粘贴）
        copyRange.Copy Destination:=ThisWorkbook.Sheets("Test").Cells(lastrow_Offset + 1, "H")
    Else
        MsgBox "没有符合筛选条件的数据可以复制！"
    End If
    
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True

修改点说明 #

• 添加错误处理：当筛选后没有可见单元格时，SpecialCells会抛出错误，用On Error Resume Next避免代码崩溃，同时判断copyRange是否存在。
• 简化目标位置定位：直接用Cells(lastrow_Offset + 1, "H")定位到H列最后一行的下一行，比Offset写法更清晰。
• 先插行再粘贴：针对不连续区域，先插入足够的行，再用Copy Destination直接粘贴，比Insert更稳定，确保所有可见单元格内容都能正确粘贴。
• 限定工作表的Range引用：所有Range都明确指定所属工作表，避免活动工作表切换导致的范围错误。

额外排查建议 #

• 检查lastrow_Offset的数值：运行时可以在lastrow_Offset = ...后加Debug.Print lastrow_Offset，确认目标位置是否正确。
• 确认源数据的筛选列：Field:=37对应第37列（AK列），Field:=38对应第38列（AL列），你需要确认筛选条件是否应用到了正确的列，避免因列号错误导致没有数据被选中。

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