Изменить ссылки при копировании листа на несколько рабочих книг

Question

Я использую приведенный ниже код для копирования рабочего листа из исходной рабочей книги в несколько сотен целевых рабочих книг.Исходная рабочая таблица содержит ссылки (в формуле) на другие рабочие таблицы в исходной рабочей книге;Я хотел бы сохранить эти ссылки между листами, но в целевой книге.Можно ли изменить этот код для этого?

Option Explicit

Public Sub CopySheetToAllWorkbooksInFolder()

    Dim sourceSheet As Worksheet
    Dim folder As String, filename As String
    Dim destinationWorkbook As Workbook

    'Worksheet in active workbook to be copied as a new sheet to the destination workbook

    Set sourceSheet = ActiveWorkbook.Worksheets("Edit")

    'Folder containing the destination workbooks

    folder = "M:\Employee Information\Peter Young\Msc Project\1 - 181028 - Office First Floor\MacroCopy\"

    filename = Dir(folder & "*.xlsx", vbNormal)
    While Len(filename) <> 0
        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
        destinationWorkbook.Close True
        filename = Dir()  ' Get next matching file
    Wend
End Sub

Answer 1

Попробуйте что-то вроде этого:

Public Sub CopySheetToAllWorkbooksInFolder()

    Dim sourceWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim destinationWorkbook As Workbook
    Dim folder As String, filename As String

    'Worksheet in active workbook to be copied as a new sheet to the destination workbook
    Set sourceWorkbook = ActiveWorkbook
    Set sourceSheet = sourceWorkbook.Worksheets("Edit")

    'Folder containing the destination workbooks

    folder = "M:\Employee Information\Peter Young\Msc Project\1 - 181028 - Office First Floor\MacroCopy\"

    filename = Dir(folder & "*.xlsx", vbNormal)
    While Len(filename) <> 0
        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
        destinationWorkbook.ChangeLink Name:=sourceWorkbook.Name, NewName:=destinationWorkbook.Name, Type:=xlExcelLinks
        destinationWorkbook.Close True
        filename = Dir()  ' Get next matching file
    Wend
End Sub

Я получил это, перейдя в «Данные»> «Редактировать ссылки» с активной целевой книгой и включенным рекордером макросов, выбрав «Изменить источник» и затем перейдя к месту назначения.Учебное пособие.