Добавление рабочих листов на workbook_open

Question

У меня есть рабочий лист "StudentSheet1", который мне нужно добавлять столько раз, сколько нужно пользователю.

Например, если пользователь вводит 3 в ячейку "A1", сохраняет его и закрывает книгу.

Я хочу иметь три листа: «StudentSheet1», «StudentSheet2» и «StudentSheet3», когда рабочая книга открывается в следующий раз.

Так что у меня будет код в событии Workbook_Open. Я знаю, как вставить новые листы, но не могу вставить этот конкретный лист "StudentSheet1" три раза

Вот мой код:

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

РЕДАКТИРОВАТЬ

Извините, я неправильно прочитал вопрос, попробуйте это:

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

Почему вы хотите добавить листы в открытую книгу?Если пользователь отключает макросы, листы добавляться не будут.Как упоминал Тони, почему бы не добавить листы при вызове пользователем?

EDIT Согласно комментариям @ Sidd, если вам необходимо проверить, существует ли лист, сначала используйте эту функцию:

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

Answer 2

user793468, я бы порекомендовал другой подход. :)

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

не является надежным. Пожалуйста, смотрите эту ссылку .

---

РЕДАКТИРОВАТЬ: приведенный выше код не будет работать, если в книге заданы имена. В противном случае это абсолютно надежно. Спасибо Reafidy за это.

Я только что заметил комментарий ОП об общем диске. Добавление исправленного кода для включения запроса OP.

Испытано и проверено

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