Excel VBA代码异常：复制行后仅插入空白行而非目标内容

你的代码复制行后直接执行Insert Shift:=xlDown只会插入空白行，因为这个操作没有关联之前复制的内容。要实现将复制的行插入到"Mean"行上方，需要调整插入逻辑，同时避免Select/Selection这类易出错的操作。

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

    Dim whatToFind As String
    Dim foundTwo As Range
    Dim targetRow As Long
    Dim mainDataRange As Range

    ' 定位"Mean"所在行
    whatToFind = "Mean"
    Set foundTwo = Sheets("Sheet1").Cells.Find(What:=whatToFind, After:=Sheets("Sheet1").Cells(1, 1), _
        LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    
    If foundTwo Is Nothing Then ' 增加判断，避免找不到"Mean"时报错
        MsgBox "未找到""Mean""所在行"
        GoTo Cleanup
    End If
    targetRow = foundTwo.Row

    ' 筛选并复制符合条件的行
    With Sheets("Main")
        Set mainDataRange = .Range("A12:S12").CurrentRegion
        mainDataRange.AutoFilter Field:=19, Criteria1:="Yes"
        On Error Resume Next ' 处理没有符合条件行的情况
        mainDataRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy
        On Error GoTo 0
    End With

    ' 将复制的行插入到"Mean"行的上方
    If Not IsEmpty(Application.ClipboardFormats) Then ' 检查是否有复制内容
        Sheets("Sheet1").Rows(targetRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If

Cleanup:
    ' 清理操作
    With Sheets("Main")
        If .FilterMode Then .ShowAllData
        .Rows("3:11").EntireRow.Hidden = True
    End With
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

• 去掉多余的Select操作：直接通过工作表对象引用单元格，避免激活/选择带来的上下文错误
• 插入复制的行：使用Rows(targetRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove，该操作会自动将剪贴板内容插入到目标行上方，而非空白行
• 增加错误判断：加入foundTwo Is Nothing检查，防止找不到"Mean"时程序崩溃；同时处理无符合条件行的情况，避免复制空内容
• 优化目标行定位：直接调用Sheets("Sheet1").Cells.Find，无需先选中Sheet1，减少冗余操作

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