CODEWITHSUNDEEP
vbaexcel
user7459948
user7459948

Reputation: 33

Adding New Tabs with Excel VBA

The VBA below is supposed to look at a list on the Setup tab and create a new tab for each JobName. I'm getting an "out of range" error when executing.

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

Upvotes: 0

Views: 2570

Answers (3)

Shai Rado
Shai Rado

Reputation: 33682

There is no need to use Select, just reference Worksheets("Setup") directly using the With statement.

Try the code below:

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

Upvotes: 2

Zerk
Zerk

Reputation: 1593

Your .copy does not set a destination so it is copying it to a new workbook I assume. at which point the new workbook is selected and the Sheets("Setup") reference within the loop is out of context (new workbook doesn't have a sheet named "setup".

Either scope the copy location or reselect the workbook

Specify copy destination:

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 workbook

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

Upvotes: 1

Svekke
Svekke

Reputation: 1530

I guess you are trying to access a sheet that does not exist. Since I don't see any Sheets.Add

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

End Sub

Upvotes: -1

Related Questions