Добавление новых вкладок с помощью Excel VBA

Question

VBA ниже должен посмотреть список на вкладке «Настройка» и создать новую вкладку для каждого JobName. Я получаю ошибку «вне диапазона» при выполнении.

Sub JobTabs() 

Application.ScreenUpdating = False 
Worksheets("Setup").Select 
For i = 7 To 100 
    JobName = Sheets("Setup").Cells("D" & i).Value 
    If JobName = "" Then 
     i = 100 
    Else 
     Sheets("Job A").Copy 
     ActiveSheet.Name = JobName 
    End If 
Next i 

End Sub 

Answer 1

Я думаю, вы пытаетесь получить доступ к листу, которого не существует. Так как я не вижу Sheets.Add

Dim ws As Worksheet 
Set ws = ThisWorkbook.Sheets.Add(After:= _ 
     ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 
ws.Name = JobName 

End Sub

Answer 2

Ваш .copy не установлен пункт назначения, так что копирует его в новую книгу я предполагаю. в этот момент выбирается новая рабочая книга, а ссылка «Настройка» в цикле выходит за пределы контекста (в новой книге нет листа с именем «настройка».

Либо укажите место скопирования, либо повторно выберите Учебное пособие

Укажите копию назначения:

Sub JobTabs() 
Application.ScreenUpdating = False 
Worksheets("Setup").Select 
For i = 7 To 100 
    JobName = Sheets("Setup").Cells("D" & i).Value 
    If JobName = "" Then 
     i = 100 
    Else 
     Sheets("Job A").Copy after:=Sheets("Job A") 
     ActiveSheet.Name = JobName 
    End If 
Next i 
End Sub 

Reselect книги

Sub JobTabs() 
Application.ScreenUpdating = False 
Worksheets("Setup").Select 
For i = 7 To 100 
    ThisWorkbook.Activate 
    JobName = Sheets("Setup").Cells("D" & i).Value 
    If JobName = "" Then 
     i = 100 
    Else 
     Sheets("Job A").Copy 
     ActiveSheet.Name = JobName 
    End If 
Next i 
End Sub 

Answer 3

Там нет необходимости использовать Select, просто сослаться ence Worksheets("Setup") непосредственно с использованием инструкции With.

Попробуйте код ниже:

Sub JobTabs() 

    Dim i   As Long 
    Dim JobName  As Variant 

    Application.ScreenUpdating = False 

    With Worksheets("Setup") 
     For i = 7 To 100 
      JobName = .Range("D" & i).Value 
      If JobName <> "" Then 
       ' copy the worksheet at the end 
       Sheets("Job A").Copy After:=Sheets(ThisWorkbook.Sheets.Count)      
       ActiveSheet.Name = JobName 
      Else 
       Exit For 
      End If 
     Next i 

    End With 

    Application.ScreenUpdating = True 
End Sub