简体   繁体   中英

How create new sheets with specific names and copy specific values into new sheets

I have an excel file with a list of names(names.xlsm), I want to create another new excel file(separate.xlsx) with different sheets. The name of each sheet in separate.xlsx is a name in names.xlsx and the first cell of each sheet is the same name value.

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

''' Here is my code. It keeps showing errors and I do not know how to debug.

  1. You can create the worksheet and name it in one line. No need to create it and then name it.
  2. You need to fully qualify your objects
  3. I am assuming that the workseets with the same name as in the names.xlsm do not exist in separate.xlsx . If it does then you will have to handle that separately.

Is this what you are trying?

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM