Sub Макрос1()

    Dim LastRow As Long
    Dim Rw As Long

    Worksheets("Результат").Cells.ClearContents

    Rw = 2

    With Sheets("Банк Идей")

        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row    'определение последней строки с данными

        .Range("A1:S1").Copy Sheets("Результат").Range("A1") 'копирование названий столбцов

        For i = 2 To LastRow
            If .Cells(i, 11) = "3" Then
                If CDate(Format(.Cells(i, 9), "dd.mm.yyyy 00:00")) >= "01.01.2018" And CDate(Format(.Cells(i, 9), "dd.mm.yyyy 00:00")) <= "31.03.2018" Then
                    .Rows(i).Copy Sheets("Результат").Cells(Rw, 1)
                    Rw = Rw + 1
                End If
            End If
        Next

    End With

End Sub