CODEWITHSUNDEEP
vbaexcel
Matthew
Matthew

Reputation: 3956

Excel Macro for creating new worksheets

I am trying to loop through some columns in a row and create new worksheets with the name of the value of the current column/row that I am in.

Sub test()
    Range("R5").Select
    Do Until IsEmpty(ActiveCell)
        Sheets.Add.Name = ActiveCell.Value
        ActiveCell.Offset(0, 1).Select
    Loop
End Sub

This code creates the first one correctly starting at R5 but then it appears that the macro switches to that worksheet and doesn't complete the task.

Upvotes: 1

Views: 12926

Answers (4)

AOGSTA
AOGSTA

Reputation: 708

This is probably the simplest. No error-handling, just a one-time code to create sheets

Sub test()
Workbooks("Book1").Sheets("Sheet1").Range("A1").Activate
Do Until IsEmpty(ActiveCell)
    Sheets.Add.Name = ActiveCell.Value
    Workbooks("Book1").Sheets("Sheet1").Select
    ActiveCell.Offset(0, 1).Select
Loop
End Sub

Upvotes: 0

brettdj
brettdj

Reputation: 55692

Error handling should always be used when naming sheets from a list to handle

  • invalid characters in sheet names
  • sheet names that are too long
  • duplicate sheet names

Pls change Sheets("Title") to match the sheet name (or position) of your title sheet

The code below uses a variant array rather than a range for the sheet name for performance reasons, although turning off ScreenUpdating is likely to make the biggest difference to the user

Sub SheetAdd()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strError As String
Dim vArr()
Dim lngCnt As Long
Dim lngCalc As Long

Set ws1 = Sheets("Title")
vArr = ws1.Range(ws1.[r5], ws1.[r5].End(xltoRight))

If UBound(vArr) = Rows.Count - 5 Then
MsgBox "sheet range for titles appears to be empty"
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
End With

For lngCnt = 1 To UBound(vArr)
Set ws2 = Sheets.Add
On Error Resume Next
ws2.Name = vArr(lngCnt, 1)
If Err.Number <> 0 Then strError = strError & vArr(lngCnt, 1) & vbNewLine
On Error GoTo 0
Next lngCnt


With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
End With

If Len(strError) > 0 Then MsgBox strError, vbCritical, "These potential sheet names were invalid"

End Sub

Upvotes: 1

Scott Holtzman
Scott Holtzman

Reputation: 27259

Sheets.Add will automatically make your new sheet the active sheet. Your best bet is to declare variables to your objects (this is always best practice) and reference them. See like I've done below:

 Sub test()

    Dim wks As Worksheet
    Set wks = Sheets("sheet1")

    With wks

       Dim rng As Range
       Set rng = .Range("R5")

       Do Until IsEmpty(rng)
            Sheets.Add.Name = rng.Value
            Set rng = rng.Offset(0, 1)
       Loop

   End With

End Sub

Upvotes: 1

MikeD
MikeD

Reputation: 8941

The Sheets.Add automatically moves your selection to the newly created sheet (just like if you insert a new sheet by hand). In consequence the Offset is based on cell A1 of the new sheet which now has become your selection - you select an empty cell (as the sheet is empty) and the loop terminates.

Sub test()
Dim MyNames As Range, MyNewSheet As Range

    Set MyNames = Range("R5").CurrentRegion ' load contigeous range into variable
    For Each MyNewSheet In MyNames.Cells    ' loop through cell children of range variable
        Sheets.Add.Name = MyNewSheet.Value
    Next MyNewSheet
    MyNames.Worksheet.Select                ' move selection to original sheet
End Sub

This will work better .... you assign the list of names to an object variable of type Range and work this off in a For Each loop. After you finish you put your Selection back to where you came from.

Upvotes: 4

Related Questions