如何创建具有特定名称的新工作表并将特定值复制到新工作表中

Question

我有一个包含名称列表（names.xlsm）的 excel 文件，我想用不同的工作表创建另一个新的 excel 文件（separate.xlsx）。 在separate.xlsx 中每张表的名称是names.xlsx 中的名称，并且每张表的第一个单元格是相同的名称值。

'''VBA

Sub copy_name()
    Dim MyCell As Range, MyRange As Range, ws As Worksheet

    Dim mybook As Workbook
    Set mybook = Workbooks("names.xlsm")

    Set MyRange = mybook.Sheets("names").Range("A2:A6") 'eg. five names'

    Dim target As Workbook
    Set target = Workbooks("separate.xlsx")

    i = 1
    For Each MyCell In MyRange
    Set ws = target.Worksheets.Add(After:=Worksheets(Worksheets.Count)) ' create new worksheet in target file
    ws.Name = MyCell.Value ' renames the new worksheet
    target.Sheets(MyCell.Value).Cells(1, 1) = MyCell 'copy the value of Mycell to target sheets
    i = i + 1
    Next

    Set mybook = Nothing
    Set target = Nothing
End Sub

''' 这是我的代码。 它一直显示错误，我不知道如何调试。

Answer 1

1. 您可以创建工作表并将其命名为一行。 无需创建它然后命名它。
2. 您需要完全限定您的对象
3. 我假设与 names.xlsm 同名的工作names.xlsm在separate.xlsx不存在。 如果是这样，那么您将不得不单独处理。

这是你正在尝试的吗？

Option Explicit

Sub Sample()
    Dim wbNames As Workbook, wbSep As Workbook
    Dim rng As Range, aCell As Range

    Set wbNames = Workbooks("names.xlsm")
    Set wbSep = Workbooks("separate.xlsx")

    Set rng = wbNames.Sheets("Names").Range("A2:A6")

    For Each aCell In rng
        With wbSep
            .Sheets.Add(After:=.Worksheets(.Worksheets.Count)).Name = aCell.Value
            .Worksheets(aCell.Value).Cells(1, 1).Value = aCell.Value
        End With
    Next
End Sub