Удаление ссылок на исходную книгу в скопированном листе - PullRequest
Новая
       52

Удаление ссылок на исходную книгу в скопированном листе

0 голосов
/ 05 февраля 2020

У меня есть макрос для обычного копирования нескольких рабочих листов из рабочей книги каждая в новую рабочую книгу для удаленного редактирования. При копировании листа в новую книгу создаются ссылки на лист в исходной книге. Я могу удалить ссылки из формул, но не могу найти способ удалить ссылки из именованных диапазонов с помощью VBA (очевидно, я не хочу делать это вручную через диспетчер имен!).

Я видел описания, использующие ActiveWorkbook.Names.Add, но это означает, что я должен также добавить каждый диапазон. Я также пробовал ActiveWorkbook.BreakLink и ActiveWorkbook.Connections безуспешно. Нет ли способа отредактировать строки, чтобы избавиться от самой ссылки? Желательно с подстановочным знаком. Например, чтобы изменить "[2020 2021 activities planner.xlsm]Lists'!*" на "Lists!*" Без необходимости изменять ссылки на ячейки, например $A$2:$A$58

Мой код: 

Sub Save_NPO_XLSX()

Dim sh As Worksheet
Dim Path As String
Dim Folder As String
Dim Filename As String
Dim wb As Workbook
Dim delLinks As Variant
'
Path = "N:\ABC\DEF\GHI\Monthly plans\"
Folder = Path '& "\" & Format(Now(), "YYYYMMDD") & "\"
If Dir(Folder, vbDirectory) = "" Then MkDir Folder

Application.DisplayAlerts = False
Application.ScreenUpdating = False

    Call Unprotect_AllSheets

        For Each sh In ThisWorkbook.Worksheets

            If sh.Name = "Angie" Or sh.Name = "Brad" _
            Or sh.Name = "Hugo" Or sh.Name = "Kathie" Or sh.Name = "Sally" _
            Then

                Set wb = Workbooks.Add

                ThisWorkbook.Sheets("Instructions").Copy Before:=wb.Sheets(1)
                    Cells.Replace What:="=[wb]", Replacement:="=", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False

                ThisWorkbook.Sheets("Lists").Copy Before:=wb.Sheets(1)
                    Cells.Replace What:="=[wb]", Replacement:="=", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False

                ThisWorkbook.Sheets("Tasks").Copy Before:=wb.Sheets(1)
                    Cells.Replace What:="=[wb]", Replacement:="=", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False

                sh.Activate
                If ActiveSheet.FilterMode Then
                    ActiveSheet.ShowAllData
                End If
                ActiveSheet.Copy Before:=wb.Sheets("Lists")
                    Cells.Replace What:="=[wb]", Replacement:="=", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False

                wb.SaveAs Filename:=Folder & ActiveSheet.Name & "_Planner_" & Format(Now(), "YYYYMMDD")

                wb.Activate

                delLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

                wb.BreakLink _
                Name:=delLinks(1), _
                Type:=xlLinkTypeExcelLinks

                wb.Save

            wb.Close
            End If
        Next

    Call LockCols

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
...