Автоматическое создание рабочих листов на основе списка в excel

Question

Я пытаюсь добиться следующего.

Когда я вводим значение на листе «Мастер» в диапазоне A5: A50, выполняется макрос, который создает новый лист с тем же именем, что и значение, а затем копирует шаблон на новый лист.

В дополнение к этому, я хотел бы также скопировать значение, смежное со значением, ввести на рабочий лист мастера на этот новый рабочий лист, чтобы он автоматически выполнял вычисления.

Например, я ввожу '1' в A5 и '2' в B5. Я хотел бы создать новый лист с именем «1», скопировать шаблон из таблицы «Шаблон» и скопировать значение B5 на новый лист с именем «1».

У меня есть следующий код, но он также пытается скопировать рабочий лист шаблона с запуском макроса, что приводит к ошибке, потому что рабочий лист с именем «Шаблон» уже существует.

Sub CreateAndNameWorksheets() 
    Dim c As Range 

    Application.ScreenUpdating = False 
    For Each c In Sheets("Master").Range("A5:A50") 
     Sheets("Template").Copy After:=Sheets(Sheets.Count) 
     With c 
      ActiveSheet.Name = .Value 
      .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _ 
       "'" & .Text & "'!A1", TextToDisplay:=.Text 
     End With 
    Next c 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

правой кнопкой мыши вкладку имени Мастера рабочего листа и выберите View Code. Когда VBE откроется, вставьте следующее в окно под названием что-то вроде Book1 - Master (Code).

Private Sub Worksheet_Change(ByVal target As Range) 
    If Not Intersect(target, Rows("5:50"), Columns("A:B")) Is Nothing Then 
     On Error GoTo bm_Safe_Exit 
     Application.ScreenUpdating = False 
     Application.EnableEvents = False 
     Application.DisplayAlerts = False 
     Application.Calculation = xlCalculationManual 
     Dim r As Long, rw As Long, w As Long 
     For r = 1 To Intersect(target, Rows("5:50"), Columns("A:B")).Rows.Count 
      rw = Intersect(target, Rows("5:50"), Columns("A:B")).Rows(r).Row 
      If Application.CountA(Cells(rw, 1).Resize(1, 2)) = 2 Then 
       For w = 1 To Worksheets.Count 
        If LCase(Worksheets(w).Name) = LCase(Cells(rw, 1).Value2) Then Exit For 
       Next w 
       If w > Worksheets.Count Then 
        Worksheets("Template").Visible = True 
        Worksheets("Template").Copy after:=Sheets(Sheets.Count) 
        With Sheets(Sheets.Count) 
         .Name = Cells(rw, 1).Value2 
         .Cells(1, 1) = Cells(rw, 2).Value 
        End With 
       End If 
       With Cells(rw, 1) 
        .Parent.Hyperlinks.Add Anchor:=Cells(rw, 1), Address:="", _ 
         SubAddress:="'" & .Value2 & "'!A1", TextToDisplay:=.Value2 
       End With 
      End If 
     Next r 
     Me.Activate 
    End If 
bm_Safe_Exit: 
    Worksheets("Template").Visible = xlVeryHidden 
    Me.Activate 
    Application.Calculation = xlCalculationAutomatic 
    Application.DisplayAlerts = True 
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
End Sub 

Обратите внимание, что это зависит от вас, имеющий рабочий лист с именем Шаблон для того, чтобы генерировать новые рабочие листы. Он также сохраняет таблицу Template xlVeryHidden, что означает, что она не появится, если вы попытаетесь ее отобразить. Перейдите в VBE и используйте окно «Свойства» (например, F4), чтобы отобразить видимость.

Эта процедура должна выжить при вставке нескольких значений в A2: B50, но она отбросит предложенные имена рабочих листов в столбце A, который уже существует. Должно быть значение i как столбец A, так и столбец B любой строки до его продолжения.

В настоящее время нет чеков для недопустимых символов имени листа. Вы можете ознакомиться с ними и добавить некоторые проверки ошибок.