Отформатируйте «выпадающий список» до нормального значения при копировании

Question

У меня есть рабочая книга, из которой я извлекаю 3 конкретных листа. Проблема в том, что в этой книге одна конкретная ячейка (B1 из листа "страна 2019") представляет собой раскрывающийся список. Когда я открываю вновь созданный файл (только с 3 листами), эта ячейка B1 генерирует ошибку

Эта рабочая книга содержит одну или несколько ссылок, которые не могут быть обновлены.

Я могу разорвать ссылку вручную, удалив ссылку из «Диспетчера имен» и Сохранить, но вопрос:

Можно ли добавить строку в мой код для форматирования этой ячейки перед созданием новой книги?

Sub TwoSheetsAndYourOut()
    Dim NewName As String
    Dim nm As Name
    Dim ws As Worksheet

    If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
    "New sheets will be pasted as values, named ranges removed" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub

    With Application
        .ScreenUpdating = False

         '       Copy specific sheets
         '       *SET THE SHEET NAMES TO COPY BELOW*
         '       Array("Sheet Name", "Another sheet name", "And Another"))
         '       Sheet names go inside quotes, seperated by commas
        On Error GoTo ErrCatcher
        Sheets(Array("country 2019", "country 2018", "Combine")).Copy
        On Error GoTo 0

         '       Paste sheets as values
         '       Remove External Links, Hperlinks and hard-code formulas
         '       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = True
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

         '       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "New Copy")

         '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xlsx"
        ActiveWorkbook.Close SaveChanges:=False

        .ScreenUpdating = True
    End With
    Exit Sub
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub