Здравствуйте. Помогите отредактировать макрос. Мне надо. Открываю файл, выделяю нужный диапазон, запускаю макрос, который создает новый файл в ту папку, где лежит исходный файл (файл должен просто сохранится в папку под каким то именем, но без его автоматического открытия). [vba]
Код
Sub Лист_в_файл() Dim AW As Window Set AW = ActiveWindow For Each s In AW.SelectedSheets Set TempWindow = AW.NewWindow 'создаем отдельное временное окно s.Copy 'копируем туда лист из выделенного диапазона TempWindow.Close 'закрываем временное окно Next End Sub
[/vba]
Здравствуйте. Помогите отредактировать макрос. Мне надо. Открываю файл, выделяю нужный диапазон, запускаю макрос, который создает новый файл в ту папку, где лежит исходный файл (файл должен просто сохранится в папку под каким то именем, но без его автоматического открытия). [vba]
Код
Sub Лист_в_файл() Dim AW As Window Set AW = ActiveWindow For Each s In AW.SelectedSheets Set TempWindow = AW.NewWindow 'создаем отдельное временное окно s.Copy 'копируем туда лист из выделенного диапазона TempWindow.Close 'закрываем временное окно Next End Sub
Sub xu() Application.ScreenUpdating = False a = ThisWorkbook.Path b = Format(Now, "yy.mm.dd_hhmmss") & ".xlsx" Workbooks.Add ActiveWorkbook.SaveAs Filename:=a & "\" & b, FileFormat:=51 ThisWorkbook.Activate c = Workbooks(b).Sheets.Count Workbooks(b).Sheets(1).Name = "k#k" Application.DisplayAlerts = False If c > 1 Then For d = c To 2 Step -1 Workbooks(b).Sheets(d).Delete Next End If ActiveWindow.SelectedSheets.Copy After:=Workbooks(b).Sheets("k#k") Workbooks(b).Sheets("k#k").Delete Workbooks(b).Close True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba]так?
[vba]
Код
Sub xu() Application.ScreenUpdating = False a = ThisWorkbook.Path b = Format(Now, "yy.mm.dd_hhmmss") & ".xlsx" Workbooks.Add ActiveWorkbook.SaveAs Filename:=a & "\" & b, FileFormat:=51 ThisWorkbook.Activate c = Workbooks(b).Sheets.Count Workbooks(b).Sheets(1).Name = "k#k" Application.DisplayAlerts = False If c > 1 Then For d = c To 2 Step -1 Workbooks(b).Sheets(d).Delete Next End If ActiveWindow.SelectedSheets.Copy After:=Workbooks(b).Sheets("k#k") Workbooks(b).Sheets("k#k").Delete Workbooks(b).Close True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Nic70y, здравствуйте. Не работает. Теперь при открытии любого файла эксель открывается новый файл с именем дата_время. При запуске макроса никакой файл не сохраняется в исходную папку
Nic70y, здравствуйте. Не работает. Теперь при открытии любого файла эксель открывается новый файл с именем дата_время. При запуске макроса никакой файл не сохраняется в исходную папкуMark1976
как теперь сделать, чтобы не создавался и открывался новый файл? я макрос удалил. запускаю любой файл эксель, открываются еще 2 новых пустых файлов. как это убрать???
как теперь сделать, чтобы не создавался и открывался новый файл? я макрос удалил. запускаю любой файл эксель, открываются еще 2 новых пустых файлов. как это убрать???Mark1976
Сообщение отредактировал Mark1976 - Пятница, 17.05.2024, 12:06
Sub xu() Application.ScreenUpdating = False a = ActiveWorkbook.Path x = ActiveWorkbook.Name b = Format(Now, "yy.mm.dd_hhmmss") & ".xlsx" Workbooks.Add ActiveWorkbook.SaveAs Filename:=a & "\" & b, FileFormat:=51 Workbooks(x).Activate c = Workbooks(b).Sheets.Count Workbooks(b).Sheets(1).Name = "k#k" Application.DisplayAlerts = False If c > 1 Then For d = c To 2 Step -1 Workbooks(b).Sheets(d).Delete Next End If ActiveWindow.SelectedSheets.Copy After:=Workbooks(b).Sheets("k#k") Workbooks(b).Sheets("k#k").Delete Workbooks(b).Close True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba][p.s.]не пользуюсь ей, сегодня 1-й раз создал и удалил соот.[/p.s.]
для персональной [vba]
Код
Sub xu() Application.ScreenUpdating = False a = ActiveWorkbook.Path x = ActiveWorkbook.Name b = Format(Now, "yy.mm.dd_hhmmss") & ".xlsx" Workbooks.Add ActiveWorkbook.SaveAs Filename:=a & "\" & b, FileFormat:=51 Workbooks(x).Activate c = Workbooks(b).Sheets.Count Workbooks(b).Sheets(1).Name = "k#k" Application.DisplayAlerts = False If c > 1 Then For d = c To 2 Step -1 Workbooks(b).Sheets(d).Delete Next End If ActiveWindow.SelectedSheets.Copy After:=Workbooks(b).Sheets("k#k") Workbooks(b).Sheets("k#k").Delete Workbooks(b).Close True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba][p.s.]не пользуюсь ей, сегодня 1-й раз создал и удалил соот.[/p.s.]Nic70y
ЮMoney 41001841029809
Сообщение отредактировал Nic70y - Пятница, 17.05.2024, 14:47
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
