Sub iSort()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
Dim FAdr As String
Dim stolb As Integer
   iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
   Range("N2:O" & iLastRow).ClearContents
    Set FoundCell = Columns(2).Find("_close", , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
      FAdr = FoundCell.Address
      Do
        If Cells(FoundCell.Row - 1, "A") = "Белая" Then
          stolb = 14
        Else
          stolb = 15
        End If
          iLastRow = Cells(Rows.Count, stolb).End(xlUp).Row + 1
          Range(Cells(FoundCell.Row - 10, "B"), Cells(FoundCell.Row + 1, "B")).Copy Cells(iLastRow, stolb)
          Set FoundCell = Columns(2).FindNext(FoundCell)
        Loop While FoundCell.Address <> FAdr
     End If
End Sub