使用Excel VBA添加新选项卡

下面的VBA应该查看“设置”选项卡上的列表,并为每个JobName创build一个新的选项卡。 执行时出现“超出范围”的错误。

 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 

不需要使用Select ,只需使用With语句直接引用Worksheets("Setup")即可。

试试下面的代码:

 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 

您的.copy不会设置目标,因此它将其复制到我假设的新工作簿中。 此时新工作簿被选中,并且循环中的表格(“设置”)引用超出了上下文(新工作簿没有名为“setup”的工作表。

要么范围复制位置或重新select工作簿

指定复制目的地:

 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 

重新select工作簿

 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 

我想你正试图访问不存在的工作表。 由于我没有看到任何Sheets.Add

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

结束小组