Question

是否可以复制已命名的单元格并将其粘贴到新的工作表中，并进行名称转移？比方说，例如，我有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”，而且还粘贴了任何命名的单元格

Answer 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仅在未命名单元格（大多数没有命名）的情况下才移至下一行。

VBA从一张纸复制已命名的单元格，然后粘贴到另一个保留名称

1 个答案: