Здравствуйте! Зацепила тема https://www.planetaexcel.ru/techniques/3/160/ , но не знаю как подстроить под себя. Подскажите пожалуйста кто знает. Надо чтоб имя сохраняемого файла бралось из ячейки, в примере А1 и сохранялся файл по этому пути, а перед сохранением разрывались абсолютно все связи. Спасибо.
Вся проблема сложных программ, целых томов кодов и состоит в несоблюдении принципа лезвия Оккама: «Не следует множить сущее без необходимости». Вся гениальность в простоте.
Dobepman, вот вариант с превращением содержимого листов в значения с последующим сохранением:
Код
Sub ReSave()
Dim wb As Workbook, sh As Worksheet, wp$, aa
Set wb = ActiveWorkbook: wp = wb.Sheets(1).[a1]
For Each sh In wb.Worksheets
aa = sh.UsedRange.Value: sh.UsedRange.Value = aa
Next
wb.SaveAs wp, wb.FileFormat
End Sub
Hugo, тоже верно. А проблем с совмещенными ячейками не будет? Вариант с разбивкой листов:
Код
Sub SplitSheets()
Dim wb As Workbook, sh As Worksheet, wp$, nWB As Workbook, n%
Set wb = ActiveWorkbook
For Each sh In wb.Worksheets
If InStr(sh.[a1], "\") Then
wp = sh.[a1] & sh.Index
Else: wp = wb.Path & "\" & Date & "_" & sh.Index
End If
Set nWB = Workbooks.Add
If nWB.Worksheets.Count > 1 Then'если по действующему шаблону в новых книгах листов больше 1
Application.DisplayAlerts = False
For n = 2 To nWB.Worksheets.Count
nWB.Worksheets(2).Delete
Next
Application.DisplayAlerts = True
End If
With nWB.Sheets(1)
sh.Cells.Copy .[a1]: .Name = sh.Name: .UsedRange.Value = sh.UsedRange.Value
End With
nWB.SaveAs wp & ".xls", wb.FileFormat: nWB.Close False
Next
End Sub
Anchoret, Первый код мне больше подходит. Спасибо. сохраняет всю книгу с разъединением связей (выделенные листы игнорирует), перед нажатием кнопке запускающей макрос сохранения я выделяю листы которые нужно сохранить, но макрос сохраняет все листы книги. Подскажите как исправить? Нужно сохранять активный лист либо группу выделенных листов, в приложенном примере эту задачу выполняет SplitSheets4
Sub ReSave()
Dim wb As Workbook, sh As Worksheet, wp$, nwb As Workbook, a%, b%, aa As Sheets
Set wb = ActiveWorkbook: wp = wb.Sheets(1).[A1]
Set aa = wb.Windows(1).SelectedSheets
Set nwb = Workbooks.Add: a = aa.Count
aa.Copy before:=nwb.Worksheets(1)
Application.DisplayAlerts = False
For b = 1 To a
nwb.Sheets(b).UsedRange.Value = nwb.Sheets(b).UsedRange.Value
Next
For b = a + 1 To nwb.Sheets.Count
nwb.Sheets(a + 1).Delete
Next
Application.DisplayAlerts = True
nwb.SaveAs wp, wb.FileFormat: nwb.Close False
End Sub
Юрий М, тут копия книги создается с выделенными листами Dobepman,
Код
Sub ReSave()
Dim wb As Workbook, sh As Worksheet, wp$, nwb As Workbook, a%, b%, aa As Sheets
Set wb = ActiveWorkbook: wp = wb.Sheets(1).[A1] & ".xlsx"
Set aa = wb.Windows(1).SelectedSheets
Set nwb = Workbooks.Add: a = aa.Count
aa.Copy before:=nwb.Worksheets(1)
Application.DisplayAlerts = False
For b = 1 To a
nwb.Sheets(b).UsedRange.Value = nwb.Sheets(b).UsedRange.Value
Next
For b = a + 1 To nwb.Sheets.Count
nwb.Sheets(a + 1).Delete
Next
Application.DisplayAlerts = True
nwb.SaveAs wp, xlOpenXMLWorkbook: nwb.Close False
End Sub
Новая проблема -в книге которую сохраняю есть модуль с функцией, после копирования выделенных листов в новую книгу в ячейках где работает функция появляется #ИМЯ? Как исправить?