Option Explicit

Sub ОтЧекрыжить_InExSu()
Application.ScreenUpdating = 0
    Dim shW As Worksheet, shT As Worksheet
    Set shW = ActiveWorkbook.Worksheets("ВсеДокументы")
    Set shT = ActiveWorkbook.Worksheets("Шаблон")

    With shW
        .Range("B:B").AdvancedFilter Action:=xlFilterCopy, _
                    CopyToRange:=.Range("L1"), Unique:=True
        Dim arrUniq()
        arrUniq() = .Range("L1").CurrentRegion.Value
        .Range("L:L").Clear
        Dim rng As Range
        Set rng = .[a1].CurrentRegion
        Dim i As Long
        For i = LBound(arrUniq) + 1 To UBound(arrUniq)
            If .FilterMode Then .ShowAllData
            rng.AutoFilter _
                    Field:=2, Criteria1:=CStr(arrUniq(i, 1))
            shT.Range("A9:F" & shT.UsedRange.Rows.Count).Clear
            If .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Count > 10 Then _
               .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Offset(1).Copy _
               shT.Cells(9, 1)
            shT.Range("B9:F" & shT.UsedRange.Rows.Count).Delete _
                    Shift:=xlToLeft
            shT.Range("c5") = CStr(arrUniq(i, 1))
            shT.Copy
            Workbooks.Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs _
                    Filename:="c:\stat\" & CStr(arrUniq(i, 1)), _
                    FileFormat:=xlOpenXMLWorkbook
            ActiveWindow.Close
            Workbooks.Application.DisplayAlerts = True
        Next
    End With
Application.ScreenUpdating = 1
MsgBox "Всё!"
End Sub