Проблемы со вставкой при смещении ячеек вниз

Это должно делать то, что вам нужно:

Sub filter_copy_paste()
    
    Const FIND_THIS As String = "mean" 'use const for fixed values
    
    Dim f As Range, numRows As Long, wsSrc As Worksheet, wsDest As Worksheet
   
    Set wsSrc = ThisWorkbook.Worksheets("Main")    'source table
    Set wsDest = ThisWorkbook.Worksheets("Sheet2") 'copy to here
    
    Set f = wsDest.Cells.Find(What:=FIND_THIS, LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
    If f Is Nothing Then
        MsgBox "'" & FIND_THIS & "' not found on " & wsDest.Name, vbExclamation
        Exit Sub
    End If

    With wsSrc.Range("A12:S12").CurrentRegion
        Debug.Print "Data", .Address()
        .AutoFilter Field:=19, Criteria1: = "Yes"
        'how many rows will be copied?
        numRows = .Columns(1).SpecialCells(xlCellTypeVisible).Count
        f.Resize(numRows).EntireRow.Insert shift:=xlDown 'insert the rows
        'copy visible rows
        .SpecialCells(xlCellTypeVisible).Copy wsDest.Cells(f.Row - numRows, "A")
    End With
    
    wsSrc.ShowAllData

End Sub

Вставить отфильтрованные строки

Sub InsertFilteredRows()

    Application.ScreenUpdating = False
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    
    Dim sws As Worksheet: Set sws = wb.Sheets("Main")
    If sws.FilterMode Then sws.ShowAllData
    If sws.AutoFilterMode Then sws.AutoFilterMode = False
    
    Dim srg As Range: Set srg = sws.Range("A12").CurrentRegion
    srg.AutoFilter Field:=19, Criteria1: = "Yes"
        Dim svrg As Range: Set svrg = srg.SpecialCells(xlCellTypeVisible)
    sws.AutoFilterMode = False
    
    Dim sarg As Range, srCount As Long
    For Each sarg In svrg.Areas: srCount = srCount + sarg.Rows.Count: Next sarg
    
    'Debug.Print srg.Address, svrg.Address, srCount
    
    ' Destination
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Sheet1")
    If dws.FilterMode Then dws.ShowAllData
    
    Dim durg As Range: Set durg = dws.UsedRange
    Dim dlCell As Range: Set dlCell = durg.Cells(durg.Cells.CountLarge)
    
    ' Starting with the first cell of the used range searching by rows,
    ' attempt to find the first cell that contains the search string.
    ' The search is by default case-insensitive ('A=a').
    Dim dfCell As Range: Set dfCell = dws.Cells.Find( _
        What: = "Mean", After:=dlCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows) ' the rest are default parameters
    If dfCell Is Nothing Then Exit Sub ' string not found
    Dim dirg As Range: Set dirg = Intersect(durg, dfCell.EntireRow) _
        .Resize(srCount) ' your code additionally suggests '.Offset(-1)' !?
    
    'Debug.Print svrg.Address, dfCell.Address, dirg.Address
    
    ' Insert and copy.
    
    dirg.Insert Shift:=xlShiftDown
    ' Cannot determine the 'CopyOrigin' parameter without seeing the data.
    
    ' Copy.
    svrg.Copy dirg.Columns(1).Offset(-srCount)
    
    ' Clean up!?
    
    sws.Rows("3:11").Hidden = True
    If Not wb Is ActiveWorkbook Then wb.Activate
    dws.Select
    
    Application.ScreenUpdating = True

    ' Inform.
    
    MsgBox "Filtered rows inserted.", vbInformation

End Sub