名前付き範囲を別のワークブックにコピーする

私は自分の名前付きセルをあるワークブックから別のワークブックにコピーするためのこの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

だから、問題はそれです Workbooks(wbs) Workbookオブジェクトとして認識されません。これは、括弧内の引数がファイルパスではなくインデックス、つまり整数であると想定されるためです。

1つの解決策は、ワークブックコレクションをループ処理して、目的のパスを開いているワークブックのパスと比較することです。次に、一致するワークブックと同じ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