Automatically create new sheets...

M

Midget

I have a spreadsheet with Data that looks like the following...

A B C
1 Sheet 1 Description1 Unit of Measure 1
2 Sheet 2 Description2 Unit of Measure 2
3 Sheet 3 Description3 Unit of Measure 3

I have about 3000 sheets that I need to generate all copying data from
a template and naming it from a separate worksheet. I would obviously
try and create a Workbook with no more than 200 or so worksheets, then
create another one. The code I am currently using for copying the
template to the new sheets is...

Public Sub CopyIt()
Sheets("AUTOMATION").Select
' Determine how many cost codes are on Data sheet
FinalRow = Range("A65000").End(xlUp).Row
' Loop through each cost code on the data sheet
For x = 1 To FinalRow
LastSheet = Sheets.Count
Sheets("AUTOMATION").Select
CostCode = Range("A" & x).Value
' Make a copy of template and move to end
Sheets("Template").Copy After:=Sheets(LastSheet)
' rename the sheet and set A1 = to the costcode name
Sheets(LastSheet + 1).Name = CostCode
Sheets(CostCode).Select
Range("A1").Value = ThisTerr
Next x

End Sub

How can I not only create new sheets based on the names of the cells
in column A, but also add the data from the corresponding cells in
columns B and C to each new sheet created? Lets say that I create
sheet 1, and the data from B1 needs to go into the new sheet in cell
H11 and C1 needs to go to AI11. Could this be accomplished by
modifying the code above, or am I in way over my head?

Thanks,
Ryan
 
B

Barb Reinhardt

How can I not only create new sheets based on the names of the cells
in column A

Let's say you have data in A1 in a worksheet referred to as aWS in your
code. Use something like this

set ws = nothing
on error resume next
set ws = worksheets(aws.range("A1").value)
on error goto 0
if not ws is nothing then
Set ws = Worksheets.Add(after:=Worksheets.Count)
set ws.name = aws.range("A1").value
end if

To add the data from your aWS cell B1 to ws cell h1 do this
ws.range("H1").value = aws.range("B1").value


I think I'd add something to check the worksheet.count and if it's over 200,
to start creating a new workbook. Put this in the begining

Dim aWB as workbook
aWB = activeworkbook

After you've added your worksheets, do something like this:

if awb.worksheet.count > 0 then
Set newWB = workbooks.add
end if

I know I didn't modify your code, but I hope it gives you some idea of what
you can do.

HTH,
Barb Reinhardt
 

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