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

无需使用Select，只需使用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

Answer 2

你的.copy没有设置目的地，所以它将它复制到我假设的新工作簿。此时选择了新工作簿，并且循环中的表格（＆＃34;设置＆＃34;）引用已脱离上下文（新工作簿没有名为＆＃34的工作表;设置＆＃34;。

定位副本位置或重新选择工作簿

指定复制目的地：

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

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

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

End Sub

使用Excel VBA添加新选项卡

3 个答案: