Auto Create workbooks and worksheets per columnar data

G

Guest

I have a list of data below. I need to create a unique workbook for every
unique name, while creating the worksheets in column A assigned to that
workbook in column B.
For example, the data below says that I will have one workbook named Alan
Groby. Inside of that workbook there will be two worksheets; one named
Import/Export Compliance and the other Video Conferencing. I have verified
that all column A data is correct symbols and length for worksheet names.
Then I am looking now but I will need to copy a source worksheet data into
each worksheet in every workbook. Basically this will a template for each
worksheet; it just has some colors and stuff that is it. But my main goal is
to get workbook and worksheets created ASAP. Thank you

Column A Column B
Import/Export Compliance Alan Grobey
Video Conferencing Alan Grobey
Disaster Recovery Proposal Anne Elledge
Upholstery Move Anthony Glathar
Trade Show Booth Bill Staser
Dental Furniture Special Bill Stewart
Cuspidor Replacement Prgm Bruno Zadnik
Raw material callout on dwgs Bruno Zadnik
 
G

Guest

Try something like this:

Sub NewList()
Dim rng As Range, cell As Range
Dim startrow As Long, sh As Worksheet
Dim bk as Workbook, startrow as Long
startrow = 2

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 Savechange:=True
set bk = workbooks.Add(Template:=xlWBATWorksheet)
bk.worksheets(1).Name = cell.offset(0,-1).Value

' Change path in the next line

bk.SaveAs "c:\Myfolder\" & cell.Value & ".xls"
else
bk.Add 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
 
G

Guest

I get an error on compile because of the workbook code.

It says duplicate already.....
Dim bk as Workbook, startrow as Long

Then when I remove from the ,---> I then get an error
Named argument not found and highlights the saved:= area

Any advice?
 
G

Guest

I think I fixed the issues but as I added the "s" to the savechanges:=true it
worked. But then I get an application defined or object defined error and I
don't know where to go from here. Thanks Tom for your time.
 
G

Guest

IT works except this last piece.

bk.Add After:=bk.Worksheets(bk.Worksheets.Count)

It says teh "Add" part is not real or correct or something like that?
 
G

Guest

You are right. The object "bk", which is a workbook,
needs some property referring to a worksheet.
Therefor, please do replace the wrong statement:
bk.Add After:=bk.Worksheets(bk.Worksheets.count)
with the right statement:
bk.worksheets.Add After:=bk.Worksheets(bk.Worksheets.count)
Briefly, you have the write the word 'worksheets' between the words 'bk' and
'add'
 
G

Guest

Sub NewList()
Dim rng As Range, cell As Range
Dim sh As Worksheet
Dim bk as Workbook, startrow as Long
startrow = 2

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(Template:=xlWBATWorksheet)
bk.worksheets(1).Name = cell.offset(0,-1).Value

' Change path in the next line

bk.SaveAs "c:\Myfolder\" & cell.Value & ".xls"
else
bk.Worksheets.Add 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
 
G

Guest

Gentlemen,
THank you for your help, you came through and saved me hours worth of work.
I sincerely hope Microsoft truly understands the value you folks provide in
demonstrating the usefulness of their software.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top