Проверка подлинности Excel нарушена, когда скрипт vba сохраняет новую книгу

Question

Ответил! Спасибо Дэвиду за то, что он указал на мою проблему. Я оставил вопрос, если он помогает кому-то другому. См. Ответ ниже.

У меня есть сценарий VBA, который сохраняет каждый лист в новой книге, однако, когда я открываю новую книгу, проверка с предыдущего листа не работает. Я также обнаружил, что, когда открываются как старые, так и новые книги, валидации работают на обоих листах. Когда я закрываю старую книгу, валидация в новой книге не работает.

Я читал, что если версия старше 2013 года, то проверка должна быть на той же странице или в именованном диапазоне. Я пробовал оба из них, но ничего не изменил.

Как я могу получить валидацию для работы над новой книгой?

Редактировать: причина, по которой валидация работает, когда открыта старая книга, заключается в том, что валидация связывает именованный диапазон с именованным диапазоном в старой книге. Если я изменил ячейки в новой книге, проверка не изменится. Поэтому (см. Правление 2)

Редактировать 2: если это так, как можно переименовать диапазон на новом листе и проверить ячейку для этого диапазона? Например, мне нужен VBA для обозначения имени диапазона AF2: AF8, а затем проверить другой диапазон O2: O25000, чтобы он мог использовать только первый диапазон в качестве возможностей.

Редактировать 3 Потенциальное решение состоит в том, чтобы создать новую проверку для диапазонов, прежде чем я сохраню свой лист в новой книге. Я пытался сделать это с помощью кода ниже, но он по-прежнему не работает:

vRange = ThisWorkbook.Worksheets(2).Range("A1:G200") 

'Assigning my ranges 
IdCo = ThisWorksheet.Range("AF2:AF8") 
MeE = ThisWorksheet.Range("AG2:AG7") 
GrReEf = ThisWorksheet.Range("AH2:AH5") 
CyRePl = ThisWorksheet.Range("AI2:AI4") 
IdCo1 = ThisWorksheet.Range("O2:O25000") 


For i = 5 To ThisWorkbook.Worksheets.Count 
ThisWorkbook.Worksheets(i).Range("AF1:AL200").Value = vRange 

'Actually doing the validations 
With IdCo.Validation 
.Delete 'delete previous validation 
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
    Formula1:="='" & ws.Name & "'!" & IdCo1.Address 
End With 

Next i 

Вот исходный код:

Dim FileExtStr As String 
Dim FileFormatNum As Long 
Dim Sourcewb As Workbook 
Dim Destwb As Workbook 
Dim sh As Worksheet 
Dim DateString As String 
Dim FolderName As String 

With Application 
    .ScreenUpdating = False 
    .EnableEvents = False 
    .Calculation = xlCalculationManual 
End With 

'Copy every sheet from the workbook with this macro 
Set Sourcewb = ThisWorkbook 

'Create new folder to save the new files in 
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss") 
FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString 
MkDir FolderName 

'Copy every visible sheet to a new workbook 
For Each sh In Sourcewb.Worksheets 

    'If the sheet is visible then copy it to a new workbook 
    If sh.Visible = -1 Then 
     sh.Copy 

     'Set Destwb to the new workbook 
     Set Destwb = ActiveWorkbook 

     'Determine the Excel version and file extension/format 
     With Destwb 
      If Val(Application.Version) < 12 Then 
       'You use Excel 97-2003 
       'This is the line I put an m in 
       FileExtStr = ".xlsm": FileFormatNum = -4143 
      Else 
       'You use Excel 2007-2013 
       If Sourcewb.Name = .Name Then 
        MsgBox "Your answer is NO in the security dialog" 
        GoTo GoToNextSheet 
       Else 
        Select Case Sourcewb.FileFormat 
        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 
        Case 52: 
         If .HasVBProject Then 
          FileExtStr = ".xlsm": FileFormatNum = 52 
         Else 
          FileExtStr = ".xlsx": FileFormatNum = 51 
         End If 
        Case 56: FileExtStr = ".xls": FileFormatNum = 56 
        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 
        End Select 
       End If 
      End If 
     End With 

     'Change all cells in the worksheet to values if you want 
     ' If Destwb.Sheets(1).ProtectContents = False Then 
      ' With Destwb.Sheets(1).UsedRange 
       ' .Cells.Copy 
      ' .Cells.PasteSpecial xlPasteValues 
      ' .Cells(1).Select 
     ' End With 
     ' Application.CutCopyMode = False 
     ' End If 


     'Save the new workbook and close it 
     With Destwb 
      .SaveAs FolderName _ 
        & "\" & Destwb.Sheets(1).Name & FileExtStr, _ 
        FileFormat:=FileFormatNum 
      .Close False 
     End With 

    End If 
GoToNextSheet: 
Next sh 

MsgBox "You can find the files in " & FolderName 

With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
    .Calculation = xlCalculationAutomatic 
End With 

End Sub

Answer 1

Ответил! Моя проблема заключалась в том, что когда я копировал новую книгу, диапазон, который мои ячейки использовали для проверки, не пришел с ним (ячейки были скопированы на новые листы, но именованные диапазоны для проверки остались на старых листах, были сохранены новые листы к новой книге, валидация осталась в старой книге). Чтобы исправить это, после создания нового листа я переименовал диапазоны для проверки на новом листе. Вот код:

With Destwb 
     Worksheets(1).Range("AF2:AF8").Name = "IdCo" 
     Worksheets(1).Range("AG2:AG7").Name = "MeE" 
     Worksheets(1).Range("AH2:AH5").Name = "GrReEf" 
     Worksheets(1).Range("AI2:AI4").Name = "CyRePl" 
.SaveAs FolderName _ 
        & "\" & Destwb.Sheets(1).Name & FileExtStr, _ 
        FileFormat:=FileFormatNum 
     End With 

Спасибо Дэвиду за то, что он указал на мою проблему.