Possibly...
Sub Copy_and_Paste_Whole_Rows()
    Dim vData As Variant
    Dim vFind As Variant
    Dim a As Integer
    Dim b As Long
    Dim c As Integer
    Dim StartRow As Long
    Dim rData As Range
    
    Application.ScreenUpdating = False
    StartRow = 15
    With Worksheets("Sheet2")
        Set rData = Application.Intersect(.Range("F:O"), .UsedRange)
        vData = rData
        vFind = Worksheets("Sheet1").Range("D3:D7")
        For a = LBound(vFind) To UBound(vFind)
            For b = LBound(vData, 1) To UBound(vData, 1)
                For c = LBound(vData, 2) To UBound(vData, 2)
                    If vFind(a, 1) = vData(b, c) Then
                        .Rows(b).Copy Worksheets("Sheet1").Rows(StartRow)
                        StartRow = StartRow + 1
                    End If
                Next c
            Next b
        Next a
    End With
    Application.ScreenUpdating = True
End Sub