VBA 正在跳过命名范围线

Question

我有一些代码将数据从一个主文件复制到另一个，然后删除命名范围并根据主文件重新创建它们（找不到更好的方法来执行此操作）。问题是，如果我运行一次代码，数据副本和所有命名范围只会被删除。如果我再次运行它，则会创建命名范围。任何想法为什么这样做？

Sub RateCardUpdate()

Dim RCWkbk As Workbook

On Error Resume Next

Set RCWkbk = Workbooks("ICARUS - Rate Card.xlsb")
If Err Then MsgBox "Please download the latest Rate Card file and open it in order to update this Rate Card."
If Err Then Exit Sub

Application.EnableCancelKey = xlDisable
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim UserWkbk As Workbook
Set UserWkbk = ThisWorkbook
Dim NR As Name

UserWkbk.Activate

    UserWkbk.Unprotect Password:="8910"
    UserWkbk.Worksheets("rc_data").Visible = True
    UserWkbk.Worksheets("rc_data").Unprotect Password:="8910"
    UserWkbk.Worksheets("drop_downs").Visible = True
    UserWkbk.Worksheets("drop_downs").Unprotect Password:="8910"

RCWkbk.Activate

    RCWkbk.Unprotect Password:="8910"
    RCWkbk.Worksheets("rc_data").Visible = True
    RCWkbk.Worksheets("rc_data").Unprotect Password:="8910"
    RCWkbk.Worksheets("drop_downs").Visible = True
    RCWkbk.Worksheets("drop_downs").Unprotect Password:="8910"

    RCWkbk.Worksheets("rc_data").Activate
    RCWkbk.Worksheets("rc_data").UsedRange.Select
    Selection.Copy

UserWkbk.Activate

    UserWkbk.Worksheets("rc_data").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

RCWkbk.Activate

    RCWkbk.Worksheets("drop_downs").Activate
    RCWkbk.Worksheets("drop_downs").UsedRange.Select
    Selection.Copy

UserWkbk.Activate

    UserWkbk.Worksheets("drop_downs").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    For Each NR In RCWkbk.Names
        UserWkbk.Names(NR.Name).Delete
        UserWkbk.Names.Add Name:=NR.Name, RefersTo:=NR.Value
    Next NR

RCWkbk.Activate

    RCWkbk.Worksheets("rc_data").Protect Password:="8910"
    RCWkbk.Worksheets("rc_data").Visible = False
    RCWkbk.Worksheets("drop_downs").Protect Password:="8910"
    RCWkbk.Worksheets("drop_downs").Visible = False
    RCWkbk.Protect Password:="8910"
    RCWkbk.Close

UserWkbk.Activate

    UserWkbk.Worksheets("rc_data").Protect Password:="8910"
    UserWkbk.Worksheets("rc_data").Visible = False
    UserWkbk.Worksheets("drop_downs").Protect Password:="8910"
    UserWkbk.Worksheets("drop_downs").Visible = False
    UserWkbk.Protect Password:="8910"

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableCancelKey = xlEnable

MsgBox "The Rate Card has been updated."

End Sub

这就是所有的代码。有问题的部分是：

  For Each NR In RCWkbk.Names
        UserWkbk.Names(NR.Name).Delete
        UserWkbk.Names.Add Name:=NR.Name, RefersTo:=NR.Value
  Next NR

Answer 1

就像 Jeeped 的评论一样，在删除 Name Range 之前为某些变量分配 Named Range 数据，以便在删除后使用它们。

Dim NameRangeData As String, NameRangeName As String
For Each NR In RCWkbk.Names
    NameRangeName = NR.Name
    NameRangeData = NR.Value
    UserWkbk.Names(NR.Name).Delete
    UserWkbk.Names.Add Name:=NameRangeName, RefersTo:=NameRangeData
Next NR