K
K
A B……..col
Worksheets Workbooks……Headings
CC JIM
DD JIM
XX KIM
EE KIM
ZZ TIM
AA TIM
I have two worksheets in workbook. One name is "Sheet1" and the other
name is "Template". In "Sheet1" I have above list of data. I need to
create a unique workbook for every unique name in column B, while
copying the worsheet "Template" to new workbook and giving the
worksheets names which are in column A assigned to that workbook in
column B. I have research the group and found the macro below and
done few changes in it but its not working.
Macro*******************
Sub NewList()
Dim startrow As Long
Dim Templatesh As Worksheet
Dim rng As Range, cell As Range
Dim bk As Workbook
startrow = 2
Set Templatesh = Worksheets("Template")
With Worksheets("Sheet1")
Set rng = .Range(.Cells(startrow, 2), .Cells(startrow, 2).End(xlDown))
End With
For Each cell In rng
If cell.Value <> cell.Offset(-1, 0) Then
If Not bk Is Nothing Then bk.Close Savechanges:=True
Set bk = Workbooks.Add
Templatesh.Copy after:=bk.Worksheets(bk.Worksheets.Count)
ActiveSheet.Name = cell.Offset(0, -1)
bk.SaveAs "C:\My Document\Record\" & cell.Value & ".xlsx"
Else
Templatesh.Copy after:=bk.Worksheets(bk.Worksheets.Count)
ActiveSheet.Name = cell.Offset(0, -1)
End If
Next
If Not bk Is Nothing Then bk.Close Savechanges:=True
End Sub
****************************
I am getting error on line "Templatesh.Copy after:=bk.Worksheets
(bk.Worksheets.Count)". Please can any friend can help
Worksheets Workbooks……Headings
CC JIM
DD JIM
XX KIM
EE KIM
ZZ TIM
AA TIM
I have two worksheets in workbook. One name is "Sheet1" and the other
name is "Template". In "Sheet1" I have above list of data. I need to
create a unique workbook for every unique name in column B, while
copying the worsheet "Template" to new workbook and giving the
worksheets names which are in column A assigned to that workbook in
column B. I have research the group and found the macro below and
done few changes in it but its not working.
Macro*******************
Sub NewList()
Dim startrow As Long
Dim Templatesh As Worksheet
Dim rng As Range, cell As Range
Dim bk As Workbook
startrow = 2
Set Templatesh = Worksheets("Template")
With Worksheets("Sheet1")
Set rng = .Range(.Cells(startrow, 2), .Cells(startrow, 2).End(xlDown))
End With
For Each cell In rng
If cell.Value <> cell.Offset(-1, 0) Then
If Not bk Is Nothing Then bk.Close Savechanges:=True
Set bk = Workbooks.Add
Templatesh.Copy after:=bk.Worksheets(bk.Worksheets.Count)
ActiveSheet.Name = cell.Offset(0, -1)
bk.SaveAs "C:\My Document\Record\" & cell.Value & ".xlsx"
Else
Templatesh.Copy after:=bk.Worksheets(bk.Worksheets.Count)
ActiveSheet.Name = cell.Offset(0, -1)
End If
Next
If Not bk Is Nothing Then bk.Close Savechanges:=True
End Sub
****************************
I am getting error on line "Templatesh.Copy after:=bk.Worksheets
(bk.Worksheets.Count)". Please can any friend can help