Create new workbook with named tabs-CodePudding

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.

CodePudding user response：

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

CodePudding user response：

You are adding a workbook, once that workbook has been created it becomes the active workbook. If you want to use activeworkbook and activesheet to set the sheet name range, you could to do this before adding the new workbook. Once you have run the code, you can delete the first sheet.

I think in this sample, you don't need activeworkbook because you are using activesheet

BTW I6:I12 would be 7 items not 5.

It need to be in chronological order. Something like this.

    Sub CreateForm()
    Dim xRg As Range,rng as range
    Dim wSh As Worksheet
    Dim wBk As Workbook,bk as workbook
    Set wBk = ActiveWorkbook
    Set wSh = ActiveSheet
    Set rng= wsh.range("I6:I12")
    set bk = workbooks.add

    For Each xRg In rng
        With bk
            .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

CodePudding user response：

(a) wSh is set to the active sheet of the new created workbook and that is empty, therefore xRg.Value is always empty. This explains why your sheets are not renamed. Set it to the sheet holding the sheet names, eg

 Set wSh = ThisWorkbook.Sheets(1)

(b) When you create a new Workbook, you will have (depending on your Excel settings) at least 1 worksheet. In your loop, you create a new sheet for every iteration, leaving the original sheets untouched. This explains why you have one sheet more than you expect.

Dim newSheetCount As Long
For Each xRg In wSh.Range("I6:I12")
    With wBk
        newSheetCount = newSheetCount   1
        ' Add a new sheet if needed.
        if .Sheets.Count < newSheetCount Then .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

(c) Copying a sheet is easy, just use the Worksheet.Copy method:

ThisWorkbork.Sheets("Result").Copy After:=.Sheets(.Sheets.Count)