Pasting while shifting cells down

I am trying to copy info from a workbook into another workbook and paste while shifting cells down.
The code does everything it is supposed to except for pasting the rows: it inserts a new blank row instead of inserting the copied rows.

Sub filter_copy_paste()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim whatToFind As String
Dim foundTwo As Range
Dim newSelectionRange As Range
Dim rowSelectionRange As Range
Dim Found_Row As Long
Dim num As Integer

Sheets("Sheet1").Select

whatToFind = "Mean"
    
Set foundTwo = Cells.Find(What:=whatToFind, After:=ActiveCell, LookIn:=xlFormulas2, _
  LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
  MatchCase:=False, SearchFormat:=False)
'
Found_Row = foundTwo.row

With Sheets("Main").Range("A12:S12").CurrentRegion
    .AutoFilter Field:=19, Criteria1:="Yes"
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy
        
    '_
    ' Destination:=Sheets("Sheet1").Range("A1")
    '
    ' I added the following line to insert selection and shift down in Cells above mean
    '
    Set rowSelectionRange = Rows(Found_Row - 1).Resize(1)
    rowSelectionRange.Select
    Selection.Insert Shift:=xlDown
End With
    
'
'Following is added to clean up my previous worksheet
'
Sheets("Main").Select
If ActiveSheet.FilterMode = True Then
    ActiveSheet.ShowAllData
End If
        
Sheets("Main").Select
Rows("3:11").Select
Range("A11").Activate
Selection.EntireRow.Hidden = True
Application.CutCopyMode = False
    
Sheets("Sheet1").Select
    
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

I expect the copied rows to be inserted in the range above Mean.

This should do what you need:

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

Insert Filtered Rows

<!-- language: lang-vb -->

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