☰

Excel 代码用于创建工作表的多个副本，副本根据其他工作表中的列表命名

tag-icon • tag-icon microsoft-excel vba
Excel 代码用于创建工作表的多个副本，副本根据其他工作表中的列表命名

我是一个相对基础的 Excel 用户，需要帮助解决一些我知道可行但对我来说太复杂而无法理解的事情。

基本上，我在 Excel 工作表中有一个列表（称为“列表”），列表中的每个条目都需要一张自己的工作表，从已设置的原始工作表（称为“RJF”）复制而来。列表从第 6 行开始。

“列表”表中的 A 列包含每个列表项的代码。B 列包含每个列表项的名称。

对于“列表”中的每个项目，需要使用 A 列中的值来命名复制的工作表，并将其拖放到副本的 A1 单元格中。B 列中的条目需要拖放到副本的 B1 单元格中。

有人能帮我解决这个问题吗？我找到了类似的查询，也有答案，但总是有额外的要求，我不知道如何在不影响我想要的方面的情况下删除它们。

答案1

我是原始发帖人。抱歉没有按照正常做法发帖。我在一个相当相似的查询的答案中找到了与我需要的类似的代码。我根据我的需要对其进行了调整：

Sub MoreAndMoreSheets()

Dim ListSh As Worksheet, BaseSh As Worksheet
Dim NewSh As Worksheet
Dim ListOfNames As Range, LRow As Long, cell As Range

With ThisWorkbook
    Set ListSh = .Sheets("List")
    Set BaseSh = .Sheets("Base")
End With

LRow = ListSh.Cells(Rows.Count, "A").End(xlUp).Row '--Get last row of list.
Set ListOfNames = ListSh.Range("A6:A" & LRow) '--Qualify our list.

With Application
    .ScreenUpdating = False '--Turn off flicker.
    .Calculation = xlCalculationManual '--Turn off calculations.
End With

For Each cell In ListOfNames '--For every name in list...
    BaseSh.Copy After:=Sheets(Sheets.Count) '--Copy Base sheet.
    Set NewSh = ActiveSheet '--Let's name it NewSh.
    With NewSh
        On Error GoTo Boom '--In case of errors.
        .Name = cell.Value '--Set the sheet's name to that of our current name in list.
        GoTo LetUsContinue '--Skip to the LetUsContinue block.
Boom: '--In case of duplicate names...
        .Name = "Dup" & cell.Value '--Add "Dup" to beginning.
        .Tab.ColorIndex = 53 '--Change the tab color of the duplicate tab to orange for easy ID.
LetUsContinue:
        On Error GoTo 0 '--Turn off error handling.
        .Range("A1") = cell.Value
        .Calculate '--Calculate page.

    End With
Next cell

With Application
    .ScreenUpdating = True '--Return to proper state.
    .Calculation = xlCalculationAutomatic '--Return to automatic calculation.
End With

BaseSh.Activate '--Select Base.
MsgBox "Done!" '--Done!

End Sub

我使用了一个 vlookup 来引用基础表的单元格 B1 中的列表表，这完成了我对第二列提取的要求：

=VLOOKUP(A1,'列表'!A6:B500,2,FALSE)

感谢 TheLaughingMan，如果他读过这篇文章，因为他的代码是我改编的。

相关内容