AccountantHarry
New Member
- Joined
- Oct 13, 2019
- Messages
- 18
Hi All,
Hope you all are safe and well.
I have been struggling with a macro for a good few hours now, hope that some of you will be so kind to help me. I managed to find codes but I am unable to get it worked.
I have a workbook with multiple worksheets, I am trying to get the macro to copy some worksheets and paste into a new workbook then delete all external links, however, there are name ranged refer to the external links, hence the relevant name ranges need to be deleted first.
1. Copy specific worksheets and paste into a new workbook
I am ok with the codes for this part.
Sheets(Array("China Overview", "China NBs won", "China Prospects", "China others", "China NPI")).Copy
2. Delete names refer to the external links.
I have found the following codes from other threads but it doesn't work, also I don't want the macro to delete all names as some values will show error.
Dim uniqueName As Name
Dim extLink As Variant, arrayXValues() As Variant, arrayValues() As Variant
Dim wb As Workbook
Dim sh As Worksheet, sh_temp As Worksheet
For Each uniqueName In wb.Names
If isNameLinkOffWorkbook(uniqueName) = True Then
uniqueName.Delete
End if
Next uniqueName
For Each sh in wb.worksheets
--------
Function isNameLinkOffWorkbook(namedRangeName As Name) As Boolean
If ActiveWorkbook.Names(namedRangeName.Name).RefersTo Like "*[[]*" Or ActiveWorkbook.Names(namedRangeName.Name).RefersTo Like "*\*" Then
isNameLinkOffWorkbook = True
End if
End Function
3. Delete external links
After deleting the name ranges attached to the external links (in 2 above), delete all external links, all formulae should turn into value.
I have got the codes below. As there is an error in 2 above, this part won't work.
For Each extLink In wb.LinkSources(xlExcelLinks)
wb.BreakLink extLink, xlExcelLinks
Next extLink
End if
4. Save the workbook in a specific folder and name
I am ok with this part.
' ActiveWorkbook.SaveAs Filename:= _
"D:\ Sales\2020 - 2021\Reports\China Sales Reports Master.xlsx"
End sub
-----------------------------------
Kind Regards
Hope you all are safe and well.
I have been struggling with a macro for a good few hours now, hope that some of you will be so kind to help me. I managed to find codes but I am unable to get it worked.
I have a workbook with multiple worksheets, I am trying to get the macro to copy some worksheets and paste into a new workbook then delete all external links, however, there are name ranged refer to the external links, hence the relevant name ranges need to be deleted first.
1. Copy specific worksheets and paste into a new workbook
I am ok with the codes for this part.
Sheets(Array("China Overview", "China NBs won", "China Prospects", "China others", "China NPI")).Copy
2. Delete names refer to the external links.
I have found the following codes from other threads but it doesn't work, also I don't want the macro to delete all names as some values will show error.
Dim uniqueName As Name
Dim extLink As Variant, arrayXValues() As Variant, arrayValues() As Variant
Dim wb As Workbook
Dim sh As Worksheet, sh_temp As Worksheet
For Each uniqueName In wb.Names
If isNameLinkOffWorkbook(uniqueName) = True Then
uniqueName.Delete
End if
Next uniqueName
For Each sh in wb.worksheets
--------
Function isNameLinkOffWorkbook(namedRangeName As Name) As Boolean
If ActiveWorkbook.Names(namedRangeName.Name).RefersTo Like "*[[]*" Or ActiveWorkbook.Names(namedRangeName.Name).RefersTo Like "*\*" Then
isNameLinkOffWorkbook = True
End if
End Function
3. Delete external links
After deleting the name ranges attached to the external links (in 2 above), delete all external links, all formulae should turn into value.
I have got the codes below. As there is an error in 2 above, this part won't work.
For Each extLink In wb.LinkSources(xlExcelLinks)
wb.BreakLink extLink, xlExcelLinks
Next extLink
End if
4. Save the workbook in a specific folder and name
I am ok with this part.
' ActiveWorkbook.SaveAs Filename:= _
"D:\ Sales\2020 - 2021\Reports\China Sales Reports Master.xlsx"
End sub
-----------------------------------
Kind Regards