Как-то так…
[offtop]Очень сильно напрягает фраза: «Ну, как-то так…», — произнесённая за спиной в тату-салоне.[/offtop]
[vba]Код
Public Sub www()
Dim sh As Worksheet, i&
Application.DisplayAlerts = 0
Application.ScreenUpdating = 0
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Сводный план" Then sh.Delete
Next
Set sh = Sheets("Сводный план")
For i = 6 To 17
sh.[a3].CurrentRegion.AutoFilter i, "<>"
sh.Range("F:q").EntireColumn.Hidden = -1
sh.Columns(i).Hidden = 0
sh.[a3].CurrentRegion.SpecialCells(12).Copy _
Worksheets.Add.[a3]
ActiveSheet.Name = sh.Cells(3, i)
ActiveSheet.Move after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
sh.AutoFilterMode = 0
Next
sh.Range("F:q").EntireColumn.Hidden = 0
Application.DisplayAlerts = -1
Application.ScreenUpdating = -1
End Sub
[/vba]
[p.s.]на более осмысленное название файла фантазии не хватило?