Друзья, вот тут есть такой макрос, вернее их было 13 и для каждого листа запускался отдельно, но высыпал ту же ошибку (automation error вызванный объект был отключен от клиентов после запуска макросов), решил исправить макрос, но не отходя долеко от шаблона исходного макроса, если я пробегаю по макросу через клавишу F8 то ошибок не возникает, если запускаю макрос ошибка и может быть при 2 проходе цикла, а может и на 5, если есть мысли как и что, посоветуйте, если нужен файл откуда берутся данные, то он тут , мозг кипит...((
Код |
---|
Application.ScreenUpdating = False Myarr = Array("ГСПП1", "ГСПП2", "ГСПП3", "ГСПП4", "ГСПП5", "ГСПП6", "ГСПП7", "ГСПП8", "ГСПП9", "ГСПП10", "ГСПП11", "ГСПП12", "ГСПП13") Set wb = Workbooks.Open("C:\Users\lex\Desktop\Распределение планов.xlsx") iPath = "C:\Users\lex\Desktop\Doki\" '-путь для сохранения For Each sh In Myarr iFileName = Sheets(sh).Cells(1, 4) '-имя при сохранении файла AName1 = Sheets(sh).Range("C1") '-указываем ячейку с нахождением имени ГСППа AName2 = Sheets(sh).Range("C2") AName3 = Sheets(sh).Range("C3") AName4 = Sheets(sh).Range("C4") AName5 = Sheets(sh).Range("C5") AName6 = Sheets(sh).Range("C6") AName7 = Sheets(sh).Range("C7") AName8 = Sheets(sh).Range("C8") AName9 = Sheets(sh).Range("C9") AName10 = Sheets(sh).Range("C10") AName11 = Sheets(sh).Range("C11") AName12 = Sheets(sh).Range("C12") AName13 = Sheets(sh).Range("C13") AName14 = Sheets(sh).Range("C14") AName15 = Sheets(sh).Range("C15") AName16 = Sheets(sh).Range("C16") AName17 = Sheets(sh).Range("C17") AName18 = Sheets(sh).Range("C18") AName19 = Sheets(sh).Range("C19") Set wb_2 = Workbooks.Add wb.Activate wb_2.SaveAs Filename:=iPath & iFileName & ".xlsx": DoEvents wb.Sheets(Array(AName1, AName2, AName3, AName4, AName5, AName6, AName7, AName8, AName9, AName10, AName11, AName12, AName13, AName14, AName15, AName16, AName17, AName18, AName19)).Copy after:=wb_2.Sheets(wb_2.Sheets.Count) With wb_2 Application.DisplayAlerts = False '.Sheets("1").ScrollWorkbookTabs Position:=xlLast .Sheets("1").Visible = False .Sheets("2").Visible = False .Close 1 End With Application.DisplayAlerts = True Set wb_2 = Nothing Next Application.ScreenUpdating = True wb.Close 1 |
Если очень захотеть - можно в космос полететь ;)