Create multiple worksheets from list

K

KDP

i have a generic workbook that i create every month with sheets at the bottom
of the days of the month.

Is there anyway that i could create a macro to automatically create the
worksheets from a list of the dates needed?
 
D

Dave Peterson

One way:

Option Explicit
Sub CreateSheets()

Dim myRng As Range
Dim myCell As Range
Dim ListWks As Worksheet

If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox "Please activate the workbook to create the worksheets"
Exit Sub
End If

Set ListWks = ThisWorkbook.Worksheets("Sheet2")
With ListWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With ActiveWorkbook
For Each myCell In myRng.Cells
.Worksheets.Add _
after:=.Sheets(.Sheets.Count)
On Error Resume Next
'watch out for /'s in the sheet name!
ActiveSheet.Name = myCell.Text 'format(mycell.value,"yyyy_mm_dd")
If Err.Number <> 0 Then
MsgBox "Error renaming: " & ActiveSheet.Name
Err.Clear
End If
On Error GoTo 0
Next myCell
End With

End Sub

If you weren't skipping any dates, you could actually just build it into the
code.
 
B

Barb Reinhardt

I'd do this with a named range for the list and then create the worksheets
based upon that named range.

Let's say you have the header for the days in A1 and the list in A2- ... A n
where n is variable.

Create a worksheet level named range (I'll call it DateList) with

=offset(Sheet1!$A$1,1,0,counta(Sheet1!$A:$A)-1,1)

For your macro, do the following:

dim myRange as range
dim r as range

set myRange = nothing
on error resume next
set myRange = range("DateList")
on error goto 0
if not myRange is nothing then
for each r in myRange
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = r.value
next r
end if


Good luck!
 
K

KDP

Dave,

It is creating the sheets but they are named in sequential order (sheet1,
sheet2, sheet3, etc). It's like it is not pulling from the list I created,
and they are formatted in 'dd-mmm' if that matters.

Also, can it copy the original sheet and paste it into the new sheets?

----------------------------------------------
 
K

KDP

Also, it is renaming the sheet i've listed the dates on as the last date on
the list. (in the date list workbook, not the 'being created' book)
---------------------------
 
D

Dave Peterson

Are you sure you're pointing to the correct list?

And where is the original sheet to be copied? Is it in the workbook with the
macro or in the workbook that gets the work done?

And what is the name of that sheet?
 
K

KDP

ok,

The sheet that is to be copied is a file called BlankProduction.xls and has
no labels on the sheets (just sheet1, sheet2, sheet3.) the date list is in a
workbook called DateList.xls and the dates are listed, starting in cell A2.
It is also on "sheet1".

Do i need to change anything?



------------------------------------------------
 
D

Dave Peterson

I think so.

But I'm not sure what.

BlankProduction.xls is a workbook. You said you wanted to copy a sheet--what's
the name of the sheet? (And it's in blankproduction.xls, right?)

And where does the macro live? In DateList.xls?

This line assumes that the list lives in the workbook that contains the macro
and the sheet that holds the list is named Sheet2.
If possible, I think I'd put the worksheet to be copied into the same workbook
that holds the macro. Sheet1 would hold the list of dates (the code needs to be
changed). And the sheet to be copied to the activeworkbook multiple times would
be called Template (or whatever you want).

This would work the way I'd want (not sure if it fits your requirements):

Option Explicit
Sub CreateSheets()

Dim myRng As Range
Dim myCell As Range
Dim ListWks As Worksheet
Dim TemplateWks As Worksheet

If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox "Please activate the workbook to create the worksheets"
Exit Sub
End If

Set TemplateWks = ThisWorkbook.Worksheets("Template")

Set ListWks = ThisWorkbook.Worksheets("Sheet1")
With ListWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With ActiveWorkbook
For Each myCell In myRng.Cells
TemplateWks.Copy _
after:=.Sheets(.Sheets.Count)
On Error Resume Next
'watch out for /'s in the sheet name!
ActiveSheet.Name = myCell.Text 'format(mycell.value,"yyyy_mm_dd")
If Err.Number <> 0 Then
MsgBox "Error renaming: " & ActiveSheet.Name
Err.Clear
End If
On Error GoTo 0
Next myCell
End With

End Sub

ok,

The sheet that is to be copied is a file called BlankProduction.xls and has
no labels on the sheets (just sheet1, sheet2, sheet3.) the date list is in a
workbook called DateList.xls and the dates are listed, starting in cell A2.
It is also on "sheet1".

Do i need to change anything?

------------------------------------------------
Click to expand...
 
K

KDP

ok,

i've gotten it to copy the worksheet, but it's naming it Template(1) thru
Template(30), (30 days). I think it's got something to do with the formatting
of the days, but, i cant get my datelist format to change to yyyy_mm_dd.
ALso, it is renaming sheet1 (the datelist) as whatever day is last in the
list.


---------------------------------
 
D

Dave Peterson

It's time for you to answer some of those questions--where the code is, where
the template is and where the list is.

And if you've changed the code, it's time to post what you're using.

This line:
ActiveSheet.Name = myCell.Text
Uses whatever you see in the cell (not the formulabar).

So you'll want to share what you have in that list--both the values and what you
see.

ok,

i've gotten it to copy the worksheet, but it's naming it Template(1) thru
Template(30), (30 days). I think it's got something to do with the formatting
of the days, but, i cant get my datelist format to change to yyyy_mm_dd.
ALso, it is renaming sheet1 (the datelist) as whatever day is last in the
list.

---------------------------------
Click to expand...
 
K

KDP

ok, sorry. lol

The macro 'lives' in the Datelist.xls workbook. The date list is on "sheet1"
and the sheet to be copied is on "template".

I dont remember if i've changed it and kept/discarded changes, so, here is
the code.

Also, the dates in the cell are 1-Mar-07, 2-Mar-07, etc. and in the formula
bar is 03/01/2007.
------------------------------------------------------
Option Explicit
Sub CreateSheets()

Dim myRng As Range
Dim myCell As Range
Dim ListWks As Worksheet
Dim TemplateWks As Worksheet

If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox "Please activate the workbook to create the worksheets"
Exit Sub
End If

Set TemplateWks = ThisWorkbook.Worksheets("Template")

Set ListWks = ThisWorkbook.Worksheets("Sheet1")
With ListWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With ActiveWorkbook
For Each myCell In myRng.Cells
TemplateWks.Copy _
after:=.Sheets(.Sheets.Count)
On Error Resume Next
'watch out for /'s in the sheet name!
ActiveSheet.Name = myCell.Text 'format(mycell.value,"dd_mm_yyyy")
If Err.Number <> 0 Then
MsgBox "Error renaming: " & ActiveSheet.Name
Err.Clear
End If
On Error GoTo 0
Next myCell
End With

End Sub


------------------------------------------
 
D

Dave Peterson

The code worked fine for me.

But if I ran it a second time without deleting any worksheets that may have the
same name, I'd get an error for each worksheet that was going to use a name that
was already used.

If you got errors when you reran the code, that's the problem.
ok, sorry. lol

The macro 'lives' in the Datelist.xls workbook. The date list is on "sheet1"
and the sheet to be copied is on "template".

I dont remember if i've changed it and kept/discarded changes, so, here is
the code.

Also, the dates in the cell are 1-Mar-07, 2-Mar-07, etc. and in the formula
bar is 03/01/2007.
------------------------------------------------------
Option Explicit
Sub CreateSheets()

Dim myRng As Range
Dim myCell As Range
Dim ListWks As Worksheet
Dim TemplateWks As Worksheet

If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox "Please activate the workbook to create the worksheets"
Exit Sub
End If

Set TemplateWks = ThisWorkbook.Worksheets("Template")

Set ListWks = ThisWorkbook.Worksheets("Sheet1")
With ListWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With ActiveWorkbook
For Each myCell In myRng.Cells
TemplateWks.Copy _
after:=.Sheets(.Sheets.Count)
On Error Resume Next
'watch out for /'s in the sheet name!
ActiveSheet.Name = myCell.Text 'format(mycell.value,"dd_mm_yyyy")
If Err.Number <> 0 Then
MsgBox "Error renaming: " & ActiveSheet.Name
Err.Clear
End If
On Error GoTo 0
Next myCell
End With

End Sub

------------------------------------------
Click to expand...
 
Top