Create new workbook with named tabs

July 12, 2022

Ok what i want to do is make a macro that makes a new workbook with 5 tabs from a list in my excel.
I got the new workbook part, I got the (named) tabs part, but i’m stuck at the combination due to lack of knowledge.

Sub CreateForm()
Workbooks.Add
    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("I6:I12")
        With wBk
            .Sheets.Add After:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
    Next xRg
End Sub

It almost works, it makes a new workbook with extra tabs, but it is one too many(due to with creation it having one already), and they are not named.

Bonus Question: It would be awesome if I also could copy a tab(named "Results") from this workbook to the end of the new workbook, but this is just extra.

>Solution :

You can use this code.

I read the new worksheet names to an array.

The number of sheets in a new workbook can vary – as the user can configure this. Therefore I first delete all sheets except of the first one, then add then new sheets – and in the end delete the first one (which is left from the first deletion round)

Sub createNewWorkbookWithSheets()

Dim arrNewNames As Variant
arrNewNames = Application.Transpose(ActiveSheet.Range("I6:I12").Value)

Dim wbNew As Workbook
Set wbNew = Application.Workbooks.Add

Dim i As Long, ws As Worksheet
With wbNew

    'delete all but the first worksheet - one has to be left
    Application.DisplayAlerts = False
    For i = 2 To .Worksheets.Count
        .Worksheets(i).Delete
    Next
    Application.DisplayAlerts = True

    'add new worksheet
    For i = LBound(arrNewNames) To UBound(arrNewNames)
        Set ws = .Worksheets.Add(, .Worksheets(.Worksheets.Count))
        ws.Name = arrNewNames(i)
    Next
    
    'delete first ws
    Application.DisplayAlerts = False
        .Worksheets(1).Delete   ' the left one from the first deletion round
    Application.DisplayAlerts = True

End With

'copy result sheet from this workbook
Set ws = ThisWorkbook.Worksheets("Result")
ws.Copy , wbNew.Worksheets(wbNew.Worksheets.Count)

End Sub