Format the "Drop down list" to normal value when copying
I have a workbook from which I'm extracting 3 specific Sheets. The problem is that in this workbook one specific cell (B1 from sheet "country 2019")is a drop down list. When I open the newly generated file (with 3 sheets only) this B1 cell generates the error
This workbook contains one or more links that can not be updated.
I can break the link manually by deleting the link from "Name manager" and Save but the question is:
Can I add a line in my code to format this cell before generating the new workbook?
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