Как создавать новые листы с конкретными именами и копировать конкретные значения в новые листы

Question

У меня есть файл Excel со списком имен (names.xlsm), я хочу создать еще один новый файл Excel (Отдельный.xlsx) с различными листами.Имя каждого листа в отдельном. 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, не существуют в 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