在workbook_open上添加工作表

Question

I have an existing worksheet "StudentSheet1" which I need to add as many times as a user needs.

For eg, if a user enters 3 in cell "A1", saves it and closes the workbook.

I want to have three sheets: "StudentSheet1" , "StudentSheet2" and "StudentSheet3" when the workbook is opened next time.

So I will have the Code in "Workbook_Open" event. I know how to insert new sheets, but cant insert this particular sheet "StudentSheet1" three times

Here is my code:

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets.Add(Type:=xlWorksheet, After:=Worksheets(1))
    Application.ScreenUpdating = True
End Sub

Answer 1

EDIT

Sorry I misread the question, try this:

Private Sub Workbook_Open()
    Dim iLoop As Integer
    Dim wbTemp As Workbook

    If Not Sheet1.Range("A1").value > 0 Then Exit Sub

    Application.ScreenUpdating = False

    Set wbTemp = Workbooks.Open(Filename:="//Ndrive/Student/Student.xlsm")

    wbTemp.Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
    wbTemp.Close

    Set wbTemp = Nothing

    With Sheet1.Range("A1")
        For iLoop = 2 To .Value
            Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
            ActiveSheet.Name = "StudentSheet" & iLoop
        Next iLoop

        .Value = 0
    End With

    Application.ScreenUpdating = True

End Sub

Why are you wanting to add sheets on the workbook open? If the user disables macros then no sheets will be added. As Tony mentioned, why not add the sheets when called by the user?

EDIT As per @Sidd's comments, if you need to check if the sheet exists first use this function:

Function SheetExists(sName As String) As Boolean
    On Error Resume Next
    SheetExists = (Sheets(sName).Name = sName)
End Function

Answer 2

user793468, I would recommend a different approach. :)

wbTemp.Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)

is not reliable. Please see this link .

---

EDIT: The above code will fail if the workbook has defined names. Otherwise it is absolutely reliable. Thanks to Reafidy for catching that.

I just noticed OP's comment about the shared drive. Adding amended code to incorporate OP's request.

Tried and Tested

Option Explicit

Const FilePath As String = "//Ndrive/Student/Student.xlsm"

Private Sub Workbook_Open()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim TempName As String, NewName As String
    Dim ShtNo As Long, i As Long

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    Set wb1 = ActiveWorkbook
    Set ws1 = wb1.Sheets("Sheet1")

    ShtNo = ws1.Range("A1")

    If Not ShtNo > 0 Then Exit Sub

    Set wb2 = Workbooks.Open(FilePath)
    Set ws2 = wb2.Sheets("StudentSheet1")

    For i = 1 To ShtNo
        TempName = ActiveSheet.Name
        NewName = "StudentSheet" & i

        If Not SheetExists(NewName) Then
            ws2.Copy After:=wb1.Sheets(Sheets.Count)
            ActiveSheet.Name = NewName
        End If
    Next i

    '~~> I leave this at your discretion.
    ws1.Range("A1").ClearContents

LetsContinue:
    Application.ScreenUpdating = True

    On Error Resume Next
    wb2.Close savechanges:=False
    Set ws1 = Nothing
    Set ws2 = Nothing
    Set wb2 = Nothing
    Set wb1 = Nothing
    On Error GoTo 0

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

'~~> Function to check if sheet exists
Function SheetExists(wst As String) As Boolean
    Dim oSheet As Worksheet
    On Error Resume Next
    Set oSheet = Sheets(wst)
    On Error GoTo 0

    If Not oSheet Is Nothing Then SheetExists = True
End Function