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

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，如果我单击检查状态，则显示“Error：Source not found”。

我能做些什么吗？

我正在使用Excel 2016。

原始格式：

Answer 1

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

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

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