☰

将命名范围复制到另一个工作簿

tag-icon • tag-icon microsoft-excel vba named-ranges
将命名范围复制到另一个工作簿

我有此 VBA 代码来将命名单元格从一个工作簿复制到另一个工作簿，但它给出了Error 9: Subscript out of range。有什么想法吗？

Sub namexfr()
 wbs = "C:\Users\MousaviM\Desktop\Book1.xlsm"
 wbd = "C:\Users\MousaviM\Desktop\Book2.xlsm"
 For Each nam In Workbooks(wbs).Names
  Workbooks(wbd).Names.Add Name:=nam.Name, RefersToR1C1:=nam.RefersToR1C1
 Next
End Sub

答案1

因此，问题是Workbooks(wbs)未被识别为 Workbook 对象。这是因为括号中的参数应该是索引，即整数，而不是文件路径。

一个解决方案是循环遍历 Workbooks 集合，并将所需路径与打开的工作簿的路径进行比较。然后将 Workbook 对象设置为与匹配的工作簿相等。

在下面的代码中，我对每个工作簿都执行了此操作。由于您可能没有打开大量工作簿，因此多个循环在计算上无关紧要。

Sub namexfr()
Dim wbs As Workbook, wbd As Workbook, wb As Workbook
wbspath = "C:\Users\MousaviM\Desktop\Book1.xlsm"
wbdpath = "C:\Users\MousaviM\Desktop\Book2.xlsm"
For Each wb In Workbooks
    If wb.FullName = wbspath Then
        Set wbs = wb
        Exit For
    End If
Next wb
For Each wb In Workbooks
    If wb.FullName = wbdpath Then
        Set wbd = wb
        Exit For
    End If
Next wb
For Each nam In wbs.Names
    wbd.Names.Add Name:=nam.Name, RefersToR1C1:=nam.RefersToR1C1
Next
End Sub

相关内容