В общем решил сам. В этом варианте работает все как я и хотел. Выкладываю код.
| Код |
|---|
Sub Подготовка_удалить_колонки()
'Первая часть макроса: Перемещаем листы в новую книгу
Dim ActiveSht As Worksheet
'Dim NewWb As Workbook
Dim wbOld As Workbook, wbNew As Workbook
For Each wbOld In Workbooks
wbOldname = ActiveWorkbook.name
For Each ActiveSht In ThisWorkbook.Worksheets
ActiveSht.Visible = True ' делаем скрытые листы видимыми в исходной книге.
Next
Sheets(Array("Исходные данные", "Сопровод", "ПЗ МЭР", "ПЗ", "КЦ", "Справочник", "СПЕЦОС ОК", "СПЕЦОС ПК")).Move ' Здесь указываете имена нужных листов
Set NewWb = ActiveWorkbook
For Each ActiveSht In NewWb.Worksheets
With ActiveSht.UsedRange
.Value = .Value
End With
Next
'NewWb.SaveAs FileName:="C:\" & "Копия.xls" ' листов стало много - какое имя нужно давать для книги не знаю.
'MsgBox "Формы документов перенесены в новую книгу и сохранены.", vbInformation
'ThisWorkbook.Close SaveChanges:=False
'Вторая часть макроса: удаление внешних связей
'Dim wbOld As Workbook, wbNew As Workbook
'Set wbOld = ActiveWorkbook
'Set wbNew = Workbooks.Add(1)
Windows(wbOldname).Activate
exist_links = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(exist_links) Then
For i = LBound(exist_links) To UBound(exist_links)
' MsgBox exist_links(i)
ActiveWorkbook.BreakLink name:=exist_links(i), Type:=xlLinkTypeExcelLinks
Next
Else
MsgBox "Связей не найдено"
End If
'Третья часть макроса: Настройка формата под себя
Dim wb As Workbook
Set wb = ActiveWorkbook
'Sheets("Исходные данные").UsedRange.Value = Sheets("Исходные данные").UsedRange.Value
'Sheets("ПЗ МЭР").UsedRange.Value = Sheets("ПЗ МЭР").UsedRange.Value
'Sheets("ПЗ").UsedRange.Value = Sheets("ПЗ").UsedRange.Value
Application.DisplayAlerts = False
'Sheets("Справочник").Delete
Application.DisplayAlerts = True
'Sheets("КЦ").Visible = xlSheetsHidden
Sheets("Ф.1(1д)").Visible = xlSheetHidden |
Изменено: - 28.07.2025 09:37:18
