将工作表复制到另一个工作簿会破坏条件格式

Question

我编写此代码是为了从另一个工作簿复制工作表。 （编辑了具体的路径、文件名）

Sub CopyWorksheet()

Const directoryPath = "myPath"
Const fileName = "filname.xlsx"
Const worksheetName = "worksheetname"

Dim wbSource As Workbook
Dim wsSource As Worksheet

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wbSource = Workbooks.Add(directoryPath & fileName)
Set wsSource = wbSource.Worksheets(worksheetName)

On Error Resume Next
ThisWorkbook.Worksheets(worksheetName).Delete
On Error GoTo 0

wsSource.Copy Before:=ThisWorkbook.Worksheets(1)
wbSource.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Importing done!"
End Sub

现在这很好用，如果工作表存在则删除它然后复制它。但是原始工作表具有在复制后中断的条件格式。

如果我转到条件格式，我会收到一个 !REF 错误，例如
=[filename1.xlsx]Lists!#REF! 我尝试复制单元格而不是工作表：

Set WshSrc = ThisWorkbook.Worksheets("Source")
Set WshTrg = ThisWorkbook.Worksheets("Target")

WshSrc.Cells.Copy
With WshTrg.Cells
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteFormats 'Tried .PasteSpecial xlAll too
    .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
    Application.CutCopyMode = False
End With 

但同样的事情也会发生。数据选项卡中的链接似乎已损坏。 源是 Filename1 而不是 Filename，如果我单击检查状态，它会显示“错误：找不到源”。

有什么我可以做的吗？

我使用的是 Excel 2016。

原始格式：

Answer 1

条件格式中的链接令人头疼。我认为，您必须复制所需的工作表和“列表”工作表。

wbSource.Worksheets(Array("List", wsSource.Name)).Copy Before:=ThisWorkbook.Worksheets(1)

当然，如果您的基础工作簿中没有“列表”工作表，您需要断言。有趣的是，您不能只将“列表”保留在目标工作簿中，如果您复制没有“列表”的源工作表，CF 中的链接无论如何都会损坏。