使用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 

末次

Answer 2

故将其复制到新的工作簿我假设你.copy不设置目的地。此时新工作簿被选中并且循环中的表格（“设置”）引用超出上下文（新工作簿没有名为“setup”的工作表）

要么复制位置的范围，要么重新选择工作簿

指定复制目标：

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 

重新选择工作簿

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