Copiar intervalos nomeados para outra pasta de trabalho

Question

Eu tenho esse código VBA para copiar minhas células nomeadas de uma pasta de trabalho para outra, mas isso me dá Error 9: Subscript out of range . Alguma idéia por favor?

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

    

Answer 1

Portanto, o problema é que Workbooks(wbs) não é reconhecido como um objeto de pasta de trabalho. Isso ocorre porque o argumento entre parênteses deve ser um índice, ou seja, um inteiro, não um caminho de arquivo.

Uma solução é percorrer a coleção de pastas de trabalho e comparar o caminho desejado com os caminhos das pastas de trabalho abertas. Em seguida, defina um objeto de pasta de trabalho igual à pasta de trabalho correspondente.

No código abaixo, fiz isso para cada pasta de trabalho. Como você provavelmente não tem uma tonelada de pastas de trabalho abertas, os vários loops são computacionalmente insignificantes.

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