| Цитата |
|---|
vikttur написал:
Предожите название темы, отражающее задачу. Заменят модераторы |
Вить,
Я старый сказочник, я много сказок знаю. 
"Спокойной ночи, малыши" находится в другом месте.
одно это чего стоит
| Код |
|---|
NewBook = "" 'Создаем новую книгу |
| Код |
|---|
Sub ИД()
Application.ScreenUpdating = False 'Отключаем обновление экрана
Application.EnableEvents = False 'Отключаем отслеживание событий
Application.DisplayAlerts = False 'Отключаем вывод сообщений во время макроса
calc = Application.Calculation
Dim Papka_name1 As String, Name_file1 As String, ar
Papka_name1 = "D:\abcd" 'ThisWorkbook.Path & "\" & Sheets("Х").Cells(2, 3).Value & "- ИД.НО"
If Dir(Papka_name1, 16) = "" Then
MkDir Papka_name1
End If
Sheets(Array("Х", "Т1", "Р", "АТП", "С")).Copy ' Копируем листы
ar = Array("Т1", "Р", "АТП", "С")
For i = 0 To UBound(ar)
Sheets(ar(i)).AutoFilter.Range.AutoFilter Field:=1, Criteria1:="Да"
Next
Name_file1 = Papka_name1 & "\" & Sheets("Х").Cells(2, 3).Value & "- ИД.НО " & ".xlsx" 'Имя файла ИД редакируемый
ActiveWorkbook.SaveAs Filename:=Name_file1, FileFormat:=51
ActiveWorkbook.Close False
Exit Sub
Application.ScreenUpdating = True 'Отключаем обновление экрана
Application.EnableEvents = True 'Отключаем отслеживание событий
Application.DisplayAlerts = True 'Отключаем вывод сообщений во время макроса
Application.Calculation = calc 'Включаем автопересчет формул
End Sub |
