VBA пропускает именованные диапазоны - PullRequest
Новая
       31

VBA пропускает именованные диапазоны

0 голосов
/ 15 мая 2018

У меня есть некоторый код, который копирует данные из одного мастер-файла в другой, а затем удаляет именованные диапазоны и воссоздает их на основе мастер-файла (не смог найти лучшего способа сделать это). Проблема в том, что, если я запускаю код один раз, копии данных и все именованные диапазоны удаляются ТОЛЬКО. Если я запускаю его второй раз, именованные диапазоны создаются. Есть идеи, почему он это делает? 

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

1 Ответ

0 голосов
/ 15 мая 2018

Как и комментарий от Jeeped, назначьте данные Named Range для некоторых переменных перед удалением Name Name, чтобы вы могли использовать их после удаления. 

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
...