VBA copy named cells from one sheet and paste to another retaining names

Question

Is there any way to copy a named cell and paste it into a new sheet and have the name transfer over? Lets say for example I had a list of 5000 books and I wanted to index it so people didn't have to scroll through 4950 books to get to the "Z" section, they could just click a link and it would take them to the named cell "Section_Z".

With one sheet this would be easy but I'm using a for each loop in VBA to take specific items from a master list and divide them into three separate sheets based on some criteria. Each separate sheet has to have an index like the use case mentioned above so when the cell named "Section_Z" copies over to Sheet2 it's name and relative location would also be copied to reflect Sheet2.

This is what I have so far:

 'for loop starts going through the master list

    for Each RowCount In Worksheets("Master List").ListObjects("MasterListTable").Range.Rows

    'if statements determine the category that the product should be placed in based on Category column G.

    If Cells(RowCount.Row, 7).Value Like "Retail*" Then
    TotalRowsRetail = TotalRowsRetail + 1

     'copy the row
       RowCount.EntireRow.Copy

       'select the retail sheet and paste the row corresponding with the current iteration (this does not look for the next blank row because this macro is intended to be run occasionally to totally refresh the sheets)

        Worksheets("Retail").Select
        Worksheets("Retail").Range("A" & TotalRowsRetail).Select
        ActiveCell.Offset(1, 0).Select

        ActiveCell.PasteSpecial xlPasteValues





     ElseIf Cells(RowCount.Row, 7).Value Like "Corporate*" Then
    TotalRowsGroup = TotalRowsGroup + 1
       RowCount.EntireRow.Copy

        Worksheets("Corporate").Select
        Worksheets("Corporate").Range("A" & TotalRowsCorporate).Select
        ActiveCell.Offset(1, 0).Select

        ActiveCell.PasteSpecial



        Worksheets("Master List").Select


    Next RowCount

    'after the for each loop runs the tables in the retail and corporate sheets are resized to match the amount of data pasted in

    Worksheets("Retail").Select
     ActiveSheet.ListObjects("RetailTable").Resize Range("$A$10:$G$" & TotalRowsRetail + 1)
     Worksheets("Corporate").Select
     ActiveSheet.ListObjects("CorporatepTable").Resize Range("$A$10:$G$" & TotalCorporateGroup + 1)

The above macro works perfectly, I'm only posting it to try and give some context to what I am trying to do, which is essentially copy not just cell formatting ie 'ActiveCell.PasteSpecial xlPasteValues` but also paste any named cells.

Answer 1

After much searching I was able to cobble together a solution.

    On Error Resume Next
    ActiveWorkbook.Names.Add Name:=Worksheets("Master List").Cells(RowCount.Row,_
     1).Name.Name & "_retail", RefersTo:=RetailSheet & intCount

   intCount = intCount + 1

We add a new name to to the workbook; ActiveWorkbook.Names.Add the name comes from the existing name on the other sheet Name:=Worksheets("Master List").Cells(RowCount.Row,1).Name.Name & "_retail" the & "_retail ensures that the new name doesn't overwrite the old name because I wanted it on the same sheet.

RefersTo:=RetailSheet & intCount sets the address of the new cell ( RetailSheet is just a string =Retail!$A$ and intCount ensures that the row is relative to the row on the retail sheet rather than the master sheet.

On Error Resume Next just moves to the next row if the cell is not named (which most aren't).