VBA从一张表复制命名单元格并粘贴到另一个保留名称答案

【问题标题】：VBA copy named cells from one sheet and paste to another retaining namesVBA从一张表复制命名单元格并粘贴到另一个保留名称
【发布时间】：2018-07-20 03:12:42
【问题描述】：

有没有什么方法可以复制一个命名的单元格并将其粘贴到一个新的工作表中并让名称转移过来？例如，我有一个包含 5000 本书的列表，我想将其编入索引，这样人们就不必滚动浏览 4950 本书即可到达“Z”部分，他们只需单击一个链接，它就会将他们带到命名单元格“Section_Z”。

使用一张纸很容易，但我在 VBA 中使用for each 循环从主列表中获取特定项目，并根据某些标准将它们分成三个单独的表格。每个单独的工作表都必须具有与上述用例类似的索引，因此当名为“Section_Z”的单元格复制到 Sheet2 时，它的名称和相对位置也将被复制以反映 Sheet2。

这是我目前所拥有的：

 '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)

上面的宏工作完美，我只是发布它来尝试为我正在尝试做的事情提供一些背景信息，这实际上不仅是复制单元格格式，即“ActiveCell.PasteSpecial xlPasteValues”，而且还粘贴任何命名的单元格.

【问题讨论】：

只有描述很难理解，听起来有点像XY problem。你能提供前后结果的样本数据吗？
您可以对整个列使用命名范围（例如“A:A”）并使宏只查找最后一个填充的单元格，或者您可以只对标题使用命名范围，并使用偏移量获取以下值，直到找到一个空单元格。
感谢您的回复，根据反馈我已经彻底编辑了这个问题，因为我认为原始措辞没有完全传达我想要做的事情。
命名单元格意味着一个命名范围。这与示例代码有什么关系？ Range("Section_Z").Cut Sheet1.Range("A10") 会将命名范围 Section_Z 移动到 Sheet1.Range("A10") 并保留其名称。
您可以命名一个包含多个单元格的范围，但您也可以命名一个特定的单元格，如果您想导航到文档中的特定位置，这很有用。命名单元格有效地将超链接目标插入到文档中。从代码中我没有剪切我正在复制的单元格，所以我不知道剪切一个单元格的结果是什么，但就复制而言，单元格在复制时不会保留它的名称。

标签： excel vba

【解决方案1】：

经过大量搜索，我能够拼凑出一个解决方案。

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

   intCount = intCount + 1

我们为工作簿添加一个新名称； ActiveWorkbook.Names.Add 名称来自另一张纸上的现有名称 Name:=Worksheets("Master List").Cells(RowCount.Row,1).Name.Name & "_retail" & "_retail 确保新名称不会覆盖旧名称，因为我希望它在同一张纸上。

RefersTo:=RetailSheet & intCount 设置新单元格的地址（RetailSheet 只是一个字符串=Retail!$A$ 和intCount 确保该行相对于零售表上的行而不是主表上的行。

On Error Resume Next 如果单元格未命名（大多数未命名），则移动到下一行。

【讨论】：