automatically copy and name sheets from template

[prw79]

I have a code (see below) that would copy a template sheet and rename them from a list that is generated from another range of all days in a month. When i switch months it automatically updates the list that will generate the sheets names. It works fine except that it expects 31 days (the range length i suppose). because when i switch to a month with lesser days it gives an error: 'Run-time error 1004: Application-defined or object-defined error'

code:

Sub CopyTemplate()
    Dim wTemplate As Worksheet
    Dim wTOC As Worksheet
    Dim wCopy As Worksheet
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    Set wTemplate = Worksheets("Template")
    Set wTOC = Worksheets("Setting")
    m = wTOC.Range("m1").End(xlDown).Row
    For r = 2 To m
        wTemplate.Copy After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = wTOC.Range("m" & r).Value
    Next r
    Application.ScreenUpdating = True
End Sub

I quess it has something to do with a 'if blank than stop' coding, but my knowledge isn't sufficient enough for this.
hope someone can help and thanks for reading.

 

[Fluff]

How about

Sub CopyTemplate()
    Dim wTemplate As Worksheet
    Dim wTOC As Worksheet
    Dim wCopy As Worksheet
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    Set wTemplate = Worksheets("Template")
    Set wTOC = Worksheets("Setting")
    m = wTOC.Range("m1").End(xlDown).Row
    For r = 2 To m
        If wTOC.Range("M" & r) = "" Then Exit Sub
        wTemplate.Copy After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = wTOC.Range("m" & r).Value
    Next r
    Application.ScreenUpdating = True
End Sub

 

[prw79]

How about

Sub CopyTemplate()
    Dim wTemplate As Worksheet
    Dim wTOC As Worksheet
    Dim wCopy As Worksheet
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    Set wTemplate = Worksheets("Template")
    Set wTOC = Worksheets("Setting")
    m = wTOC.Range("m1").End(xlDown).Row
    For r = 2 To m
        If wTOC.Range("M" & r) = "" Then Exit Sub
        wTemplate.Copy After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = wTOC.Range("m" & r).Value
    Next r
    Application.ScreenUpdating = True
End Sub

Again, brilliant!

 

[Fluff]

You're welcome & thanks for the feedback.

When marking a post as the solution, please mark the post with the solution, rather than your post saying it worked. I have changed it for you this time.