Excel VBA - 重命名命名范围会导致无法读取的内容错误？

Question

I'm trying to teach myself VBA by completing a project, but unfortunately I've reached the limit of what I can figure out.

The project involves a workbook with worksheet intended to be used as a template for other worksheets. This sheet has multiple tables which are referenced by named ranges; the tables and named ranges include the word 'template'.

The template sheet is copied seven times into a new workbook. Immediately after being copied, the copied sheet is renamed for a day of the week.

I also need to rename the tables and named ranges too, but while I have discovered how to loop through and rename the tables by replacing 'template' with the appropriate day of the week, I cannot figure out how to do the same for the named ranges.

The named ranges begin as:

AHSO_Tasks_Template Refers to table _01_AHSO_Tasks_Monday[AHSO Tasks] Scope is Monday

This is mirrored for the other six days of the week, and repeated many times with different collections of words replacing AHSO_Tasks.

I run this code to rename the named ranges according to the weekday contained in the name of the table they refer to:

Sub Namedrangesloop()

Dim Nm As Name

'Loop through each named range in workbook
For Each Nm In ActiveWorkbook.Names

Dim oldrng As String
oldrng = Nm.Name

Dim rfto As String
rfto = Nm.RefersTo

Dim day As String
day = Mid(rfto, InStrRev(rfto, "_") + 1, InStr(rfto, "[") - InStrRev(rfto, "_") - 1)

Dim nwrng As String
nwrng = Replace(oldrng, "Template", day)

Nm.Name = nwrng

Next Nm

End Sub

This does work - for the above example the Name Manager will show the named range as Monday!AHSO_Tasks_Monday (so I would only then want to change the scope now the names have unique names, rather than AHSO_Tasks_Template seven times over).

But when I save and re-open the new workbook, I get the message:

Excel found unreadable content in filename.xlsx. Do you want to recover the content of this workbook? (etc).

If I click yes, I then find when I open Name Manager that all the named ranges have been deleted! What can I do to change this?

I did think of an alternative but I'm also stuck on that too!

Answer 1

You have two options in your case...

Option 1: Local worksheet-local named ranges.

In this case, your named tables use identical names but are differentiated by the sheetname.

Sunday!AHSO_Tasks or Monday!AHSO_Tasks

Clearly, renaming is no longer necessary with this option.

Option 2: Rename each table as you copy

Your named tables remain global, but are renamed on each sheet as you copy in order to avoid confusion.

Option Explicit

Sub CreateWeekdaySheets()
    Dim srcWb As Workbook
    Dim dstWb As Workbook
    Dim tmplSh As Worksheet
    Dim daySh As Worksheet
    Dim weekDays() As String
    Dim day As Variant
    Dim tbl As ListObject
    Dim newName As String

    weekDays = Split("Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday", ",", , vbTextCompare)

    Set srcWb = ThisWorkbook
    Set dstWb = Workbooks.Add
    Set tmplSh = srcWb.Sheets("Template")

    For Each day In weekDays
        tmplSh.Copy After:=dstWb.Sheets(dstWb.Sheets.Count)
        Set daySh = ActiveSheet
        daySh.Name = CStr(day)
        For Each tbl In daySh.ListObjects
            newName = Replace(tbl.Name, "Template", day, , , vbTextCompare)
            tbl.Name = newName
        Next tbl
    Next day

End Sub

Both of these options should also work if your named ranges are not applied to Tables as well.

Answer 2

I took PeterT 's solution, added one extra For Each / Next loop and got exactly what I wanted for that part of the project. But he deserves the credit!

Sub CreateWeekdaySheets()

Dim srcWb As Workbook
Dim dstWb As Workbook
Dim tmplSh As Worksheet
Dim daySh As Worksheet
Dim weekDays() As String
Dim day As Variant
Dim tbl As ListObject
Dim newName As String

Dim nm As Name 'Added by me

weekDays = Split("Monday-Tuesday-Wednesday-Thursday-Friday-Saturday-Sunday", "-", , vbTextCompare)

Set srcWb = ThisWorkbook
Set dstWb = Workbooks.Add
Set tmplSh = srcWb.Sheets("DSP Template")

For Each day In weekDays
    tmplSh.Copy After:=dstWb.Sheets(dstWb.Sheets.Count)
    Set daySh = ActiveSheet
    daySh.Name = CStr(day)
    For Each tbl In daySh.ListObjects
        newName = Replace(tbl.Name, "Template", day, , , vbTextCompare)
        tbl.Name = newName
    Next tbl
    For Each nm In dstWb.Names 'Added by me
        nm.Name = Replace(nm.Name, "Template", day) 'Added by me
    Next nm 'Added by me
Next day

ActiveWindow.TabRatio = 0.7

End Sub