使用VBA将所有命名范围复制到另一个工作簿

问题描述

请先阅读以下内容； Copy all named ranges to another workbook。我正在尝试同样的方法，此页面上的答案以及其他网站上的信息使我无处可寻。

我稍微修改了代码。使用此代码，我得到以下错误；错误1004“应用程序定义或对象定义的错误”。非常感谢您的帮助。 错误显示在以下行：“ ThisWorkbook.Names.Add Name：= x.Name，RefersTo：= x.Value”

Sub copyNames()
'Gedefineerde namen kopiëren naar andere werkmap.
    Dim x As Name
    Dim wbDatabase As Workbook
    Set wbDatabase = Workbooks("Database.xlsx")
    
    For Each x In wbDatabase.Names
        ThisWorkbook.Names.Add Name:=x.Name,RefersTo:=x.Value
    Next x
End Sub

解决方法

我偶然找到了解决我问题的方法。一个隐藏的名称由Excel创建，名为_FilterDatabase。我在以下站点（https://www.reddit.com/r/excel/comments/78t8mw/what_function_do_the_automatically_generated/）上了解到，只要您在工作簿中进行过滤，便会创建此名称。 由于_FilterDatabase不是以字母开头，因此它在CopyNames代码中给出了错误。由于我经常使用过滤器，因此从长远来看，删除名称不会对我有帮助。当我使用过滤器时，Excel会再次创建名称。我在以下站点上找到了解决方案； https://www.mrexcel.com/board/threads/excel-keeps-creating-a-hidden-_xlfn-iferror-name-why.1081695/。

---

首先，我在数据库工作簿中使用以下宏取消隐藏所有已定义的名称：

Sub ShowAllNames()
   Dim x As Name
   For Each x In ActiveWorkbook.Names
       x.Visible = True
   Next x
End Sub

在取消隐藏所有定义的名称之后，我立即在列表顶部看到了_FilterDatabase名称。然后，我在其他工作簿的CopyNames代码中添加了“ If not x.Name like“ _Filter *” Then“行。通过在代码中添加此行，代码将跳过以_Filter开头的所有名称。这是完整的代码；

Sub CopyNames()
'Gedefineerde namen kopiëren naar andere werkmap.
    Dim x As Name
    Dim wbDatabase As Workbook
    Set wbDatabase = Workbooks("Database.xlsx")
    
    For Each x In wbDatabase.Names
        If Not x.Name Like "_Filter*" Then
          ThisWorkbook.Names.Add Name:=x.Name,RefersTo:=x.Value
        End If
    Next x
End Sub