Copy named ranges to the active sheet

Question

I'm trying to copy named ranges from the Wk1 worksheet to the active sheet in the workbook.

I keep getting error messages when I run the code. They either say an Object is not set or a variable has not been declared.

Sub ChangeNamedRangesOnNewWKsheet()
    Dim RangeName As Name
    Dim HighlightRange As Range
    Dim RangeName2 As String
    Dim NewRangeName As String
    Dim Ws As Worksheets
    Dim cs As Worksheet
    Set cs = Application.ActiveSheet

    '''''   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 Ws
        If InStr(1, RangeName, "Wk1", 1) > 0 Then
            Set HighlightRange = RangeName.RefersToRange
            NewRangeName = Replace(RangeName.Name, "Wk1", "cs.Name")
            RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'")
            On Error Resume Next
            HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2)
            Range(RangeName2).Name = NewRangeName
            On Error GoTo 0
        End If
    Next RangeName

    MsgBox "Done"    
End Sub

Ive changed the code to this. Im not getting error messages but the code is still not working. the named ranges are not copying from the Wk1 sheet to the Active sheet. The only thing that happens is that the Message Box Opens

Sub ChangeNamedRangesOnNewWKsheet()

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

    Dim Cs As Worksheet
    Set Cs = Application.ActiveSheet

    '''''   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, "Wk1", "cs.Name")
                RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'")
                On Error Resume Next
                HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2)
                Range(RangeName2).Name = NewRangeName
                On Error GoTo 0
            End If
        Next RangeName
           MsgBox "Done"
    End Sub

Answer 1

Took me some time to figure out whats not working when there is no error, but finally I think I managed to figure out the issue.

Replace the following line in your code

HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2)

to:

HighlightRange.Copy Destination:=Worksheets(cs.Name).Range(HighlightRange.Address)

This should give you desired result.

Syntax for Copy to destination is Destination:=Worksheets("sheet_name").Range(range). Here sheet_name should be the name of the sheet. So when you write Worksheets("cs.Name") code looks for the sheet named cs.Name which actually does not exist hence just use Worksheets(cs.Name). Second thing here is range (just to explain things better I am using $A$1:$A$5 as range). When you write .Range(RangeName2) code is looking for 'cs.Name'!$A$1:$A$5. Again this is incorrect because range should be written as .Range($A$1:$A$5). So .Range(HighlightRange.Address) will give you the proper range.

You can also play out in the line RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'") to get proper address.

Hope this helps.

EDIT : __________________________________________________________________________________

example of what i want. copy the named range Wk1Totalhrs from Wk1 sheet to Wk2-Wk7 sheets so that Wk1Totalhrs becomes Wk2Totalhrs,Wk3Totalhrs etc on the corresponding new sheet

Try the following code to achieve what you mentioned as your requirement in comment (or as above).

Sub ChangeNamedRangesOnNewWKsheet()
    Dim RangeName As Name
    Dim HighlightRange As Range
    Dim RangeName2 As String, NewRangeName As String, SearchRange As String
    Dim MyWrkSht As Worksheet, cs As Worksheet

    Set MyWrkSht = ActiveWorkbook.Worksheets("Wk1")
    SearchRange = "Wk1Totalhrs"    '---> enter name of the range to be copied

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

    'For Each RangeName In MyWrkSht.Names ActiveWorkbook.Names
    For Each RangeName In ActiveWorkbook.Names
        If RangeName.Name = SearchRange Then    '---> search for the named range Wk1Totalhrs
            Set HighlightRange = RangeName.RefersToRange
            For Each cs In ActiveWorkbook.Sheets
                Debug.Print cs.Name
                If cs.Name <> "Wk1" Then    '---> don't do anything in the sheet Wk1
                    NewRangeName = Replace(RangeName.Name, "Wk1", cs.Name)
                    RangeName2 = Replace(RangeName, "='Wk1'", cs.Name)

                    HighlightRange.Copy Destination:=Worksheets(cs.Name).Range(HighlightRange.Address)
                    Range(RangeName2).Name = NewRangeName
                End If
            Next cs
        End If
    Next RangeName
End Sub

Answer 2

I think it's just as simple as this.

Public Sub ShowNames()

Dim Nm As Name
Dim i As Long

For Each Nm In ActiveWorkbook.Names
i = i + 1
Range("A1").Offset(i, 0).Value = Nm
Next Nm

End Sub

Answer 3

^{Im not getting error messages but the code is still not working.}
_{the named ranges are not copying from the Wk1 sheet to the Active sheet.}

The following line will return false positives when the named range starts with or contains WK10, WK11, etc.

If InStr(1, RangeName, "Wk1", 1) > 0 Then

A little further down, you are quoting a variable property; this makes it a literal string, not the value of the variable property.

  NewRangeName = Replace(RangeName.Name, "Wk1", "cs.Name")

You need a more concrete way to identify the defined names on WK1. After looking closely at your problem, I believe that you may have one or more dynamic named ranges that are defined by formulas. This would explain some of the 'not working' behavior of your code that should be working with more conventional ReferTo: properties.

There is also the problem of whether you should rewrite the RefersTo: of an existing defined named range or add a new named range. One common practise is to simply attempt to delete the named range un On Error Resume Next and then create a new one. I've never liked this method for a variety of reasons; one being that deleting a named range will make dependent named ranges refer to #REF! and I've never considered on error resume next to be a 'best practise'.

The following builds a dictionary of keys containing named ranges to be created and ones that already exist using multiple criteria. I've tested this repeatedly on a combination of conventional and dynamic named ranges with success.

Option Explicit

Sub ChangeNamedRangesOnNewWKsheet()
    Dim nm As Name
    Dim rtr As String, nm2 As String
    Dim w As Long
    Dim k As Variant, dict As Object

    Set dict = CreateObject("Scripting.Dictionary")
    dict.comparemode = vbTextCompare
    With ActiveWorkbook
        'Delete invalid named ranges and build dictionary of valid ones from WK1
        For Each nm In .Names
            If CBool(InStr(1, nm.RefersTo, "#REF!", vbTextCompare)) Or _
               CBool(InStr(1, nm.RefersTo, "#NAME?", vbTextCompare)) Then
                'Debug.Print nm.Name
                On Error Resume Next
                nm.Delete
                Err.Clear
                On Error GoTo 0
            ElseIf LCase(Left(nm.Name, 3)) = "wk1" And _
                   (CBool(InStr(1, nm.RefersTo, "wk1!", vbTextCompare)) Or _
                    CBool(InStr(1, nm.RefersTo, "'wk1'!", vbTextCompare))) Then
                dict.Item(Mid(nm.Name, 4)) = LCase(nm.RefersTo)
            ElseIf LCase(Left(nm.Name, 2)) = "wk" Then
                dict.Item(nm.Name) = LCase(nm.RefersTo)
            End If
        Next nm

        For w = 1 To Worksheets.Count
            With Worksheets(w)
                If LCase(.Name) <> "wk1" And Left(LCase(.Name), 2) = "wk" Then
                    For Each k In dict
                        If dict.exists(.Name & k) Then
                            .Parent.Names(.Name & k).RefersTo = _
                                Replace(LCase(dict.Item(k)), "wk1", .Name, 1, -1, vbTextCompare)
                        ElseIf Left(LCase(k), 2) <> "wk" Then
                            .Parent.Names.Add _
                                Name:=.Name & k, _
                                RefersTo:=Replace(LCase(dict.Item(k)), "wk1", .Name, 1, -1, vbTextCompare)
                        End If
                    Next k
                End If
            End With
        Next w

    End With

    dict.RemoveAll: Set dict = Nothing

    'MsgBox "All worksheets done"
End Sub

Note that this creates/redefines all named ranges on all worksheets (other than WK1). As far as I can determine, the only chance to have false positives would be to have an existing named range with a name something like WK1wkrange (but that would just be silly).

Answer 4

This code works

Public Sub CopyNamedRanges()

Dim namedRange As Name
Dim targetRefersTo As String
Dim targetName As String

On Error Resume Next

For Each namedRange In ActiveWorkbook.Names
    If Left$(namedRange.RefersTo, 6) = "='Wk1'" And Left$(namedRange.Name, 3) = "Wk1" Then
        targetName = Replace(namedRange.Name, "Wk1", ActiveSheet.Name)
        targetRefersTo = Replace(namedRange.RefersTo, "Wk1", ActiveSheet.Name)
        ActiveWorkbook.Names.Add targetName, targetRefersTo ' Might error if it already exists
        ActiveWorkbook.Names(targetName).RefersTo = targetRefersTo
        namedRange.RefersToRange.Copy Range(targetName) ' Remove this line if it's not required
    End If
Next

End Sub

How the code works This part If Left$(namedRange.RefersTo, 6) = "='Wk1'" makes sure that the range refers to some cells on the sheet called Wk1 The other condition (Left$(namedRange.Name, 3) = "Wk1") would also match named ranges on sheets Wk10 - Wk19.

This part ActiveWorkbook.Names.Add targetName, targetRefersTo will adds a new named range that refers to the cells on the current sheet

This part namedRange.RefersToRange.Copy Range(targetName) copies the contents of the named range on the Wk1 sheet to the current sheet (remove the line if you don't need it)

Answer 5

Dim RangeName As Variant Try changing the variable type