How to copy named ranges from Sheet 1 to Sheet 2 and have their names update

[Course]

Hello, I have about 50 named ranges in Sheet 1(which is called Week 1). These names are named like this e.g Week1MondayWeight,Week1TuesdayWeight etc.

I want to copy these to Sheet 2(Week 2) and have their names update to Week2MondayWeight,Week2TuesdayWeight etc.

Is this possible and if so how can I do it.

Atm I am updating the names manually each time I copy to a new sheet and this is time consuming

Thank you

 

[Course]

I made a typo in above code. Correct code below

Sub CopyNamedRanges()

Dim RangeName As Name
Dim HighlightRange As Range
Dim RangeName2 As String
Dim NewRangeName As String

For Each RangeName In ActiveWorkbook.Names
Set HighlightRange = RangeName.RefersToRange
NewRangeName = Replace(RangeName.Name, "1", "2")
RangeName2 = Replace(RangeName, "=Wk1", "Wk2")
HighlightRange.Copy Destination:=Worksheets("Week2").Range(RangeName2)
Range(RangeName2).Name = NewRangeName
Next RangeName

End Sub

 

[tonyyy]

Let's try to isolate the line of code that's causing the error...

Open the Visual Basic Editor and mouse click anywhere in the code. Press F8. The "Sub copyNamedRanges()" will highlight. Press F8 again and the next line will highlight. Continue to press F8 until the error message appears, then click the "debug" button. The highlighted line is the line that's causing the error.

Please let me know.

 

[Course]

I went through the code using Step into as f8 doesnt work on my laptop for some reason. When I encountered the error message I hit Debug in the dialog window that appeared and the line below appeared in yellow.

Set HighlightRange = RangeName.RefersToRange

 

[tonyyy]

So, the only way I was able to re-create the error was to purposely add an invalid named range to the workbook. The following modified code deletes invalid named ranges before proceeding to copy the valid named ranges.

Sub CopyNamedRanges2()

Dim RangeName As Name
Dim HighlightRange As Range
Dim RangeName2 As String
Dim NewRangeName As String

'''''   Delete invalid named ranges
For Each RangeName In ActiveWorkbook.Names
    If InStr(1, RangeName.RefersTo, "#REF!") > 0 Then
        RangeName.Delete
    End If
Next RangeName
    
For Each RangeName In ActiveWorkbook.Names
    Set HighlightRange = RangeName.RefersToRange
    NewRangeName = Replace(RangeName.Name, "1", "2")
    RangeName2 = Replace(RangeName, "=Week1", "Week2")
    HighlightRange.Copy Destination:=Worksheets("Week2").Range(RangeName2)
    Range(RangeName2).Name = NewRangeName
Next RangeName

End Sub

Oh, you'll have to redo your adjustments, eg, Week1 --> Wk1...

 

[Course]

I tried the new code after adjusting it but I got the same error message. When I ran Debug the same line of code below appeared in yellow


"Set HighlightRange = RangeName.RefersToRang"

 

[tonyyy]

Are your worksheets protected?

 

[Course]

Are your worksheets protected?

When I looked in Review tab there was a tick mark saying worksheet was protected. I unticked that box and ran the MAcro but got the same result.

Is there any way I can send you the sheet to see whats wrong?

 

[Course]

This question was ansered by Tony. He provided the code below which works.

Many thankls Tony, it has saved me a lot of time.

Sub CopyNamedRanges2()

Dim RangeName As Name
Dim HighlightRange As Range
Dim RangeName2 As String
Dim NewRangeName As String

''''' Delete invalid named ranges
'For Each RangeName In ActiveWorkbook.Names
' If InStr(1, RangeName.RefersTo, "#REF!") > 0 Then
' RangeName.Delete
' End If
'Next RangeName

For Each RangeName In ActiveWorkbook.Names
If InStr(1, RangeName, "Wk1", 1) > 0 Then
Set HighlightRange = RangeName.RefersToRange
NewRangeName = Replace(RangeName.Name, "1", "2")
RangeName2 = Replace(RangeName, "='Wk1'", "Wk2")
HighlightRange.Copy Destination:=Worksheets("Wk2").Range(RangeName2)
Range(RangeName2).Name = NewRangeName
End If
Next RangeName

MsgBox "Done"

End Sub