Sub iFruit()
Dim FilteredRng As Range
Dim i As Long
Dim iLastRow As Long
Dim iFruit As String
Dim List1 As Worksheet
  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
      iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
      Set List1 = ThisWorkbook.Worksheets("Свод")
      Columns("M").ClearContents
    Range("B1:B" & iLastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("M1"), Unique:=True
    iLastRow = Cells(Rows.Count, "M").End(xlUp).Row
      For i = 2 To iLastRow
        iFruit = Cells(i, "M")
            If ActiveSheet.AutoFilterMode = False Then
                Range("A1:H1").AutoFilter
            Else
                If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
            End If
              Range("A1").AutoFilter Field:=2, Criteria1:=iFruit
            With List1.AutoFilter.Range
               Worksheets.Add After:=Worksheets(Worksheets.Count)
                ActiveSheet.Name = iFruit
                .Resize(.Rows.Count, 8).SpecialCells(xlCellTypeVisible).Copy Worksheets(iFruit).Range("A1")
                Worksheets(iFruit).Columns("A:H").AutoFit
                List1.Activate
                List1.ShowAllData
            End With
      Next
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub