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