Macro Help???

Copper Contributor

I need a little help with editing this macro. It is for my report cards and the ability to create multiple tabs. Right now it will only make 36 tabs and I need it to make 50. Can anyone help me? I tried changing i2. Its cell formula is =36-COUNTBLANK(B9:B44). When I change this it won't make any tabs. Let me know if you need any more information. THANKS!

 

Sub Copysheet()
'
' Copysheet Macro

Dim y As Integer
Sheets("Info").Unprotect
Sheets("Master").Unprotect
y = Range("i2").Value

 

Do While y > 0
On Error GoTo Skip
Sheets("info").Select
Range("I3").Value = y
Sheets("Master").Select
Sheets("Master").Copy After:=Sheets("Master")
Range("J1").Select
Range("J1").Value = y
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("a2:ac2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("c2").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Select
ActiveSheet.Name = Range("c2").Value

y = y - 1
Loop
Sheets("Master").Select
Range("j1").Value = Blank
Sheets("info").Select
Skip:
Sheets("Info").Protect
Sheets("Master").Protect
End Sub

1 Reply

@Aneatra_Walker 

What if you enter the value 50 in I2?

Or if you change the line

y = Range("I2").Value

to

y = 50

Here is a slightly shorter version of the code:

 

Sub Copysheet()
    Dim y As Integer
    Dim w As Worksheet
    Sheets("Info").Unprotect
    Sheets("Master").Unprotect
    y = Range("I2").Value
    On Error GoTo Skip
    Do While y > 0
        Sheets("Info").Range("I3").Value = y
        Sheets("Master").Copy After:=Sheets("Master")
        Set w = Sheets("Master").Next
        w.Range("J1").Value = y
        w.Range("A2:AC2").Value = w.Range("A2:AC2").Value
        w.Name = w.Range("C2").Value
        y = y - 1
    Loop
    Sheets("Master").Range("J1").ClearContents
    Sheets("Info").Select
Skip:
    Sheets("Info").Protect
    Sheets("Master").Protect
End Sub