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

У меня есть рабочий лист "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
2 ответа

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

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

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

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

РЕДАКТИРОВАТЬ В соответствии с комментариями @Sidd, если вам нужно проверить, существует ли лист, используйте эту функцию:

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


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

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

не является надежным. См. Эту ссылку.

EDIT: приведенный выше код завершится неудачно, если в книге определены имена. В противном случае он абсолютно надежный. Благодаря Реафиди, чтобы поймать это.

Я просто заметил комментарий OP об общем диске. Добавление измененного кода для включения запроса 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

licensed under cc by-sa 3.0 with attribution.