VBA Adding sheets to a workbook from a list to the end of the workbook

[bhalbach]

I am trying to add sheets to a workbook from a list...

I have it mostly working, it just puts them in the wrong order. I would like them to start at the end of the existing sheets and add to the end in the order of my list.

I have this code but it is erroring out when I try adding this >>>>after:=sheets(sheets,count) I am getting a syntax error
I know I have to count the sheets as they are added so it know where the end is but Im at a loss.

I also want to make it dynamic...so if the list grows the array picks it up and adds sheets accordingly...I havent got to this part yet


Sub addSheets()

Dim BidItem(1 To 15, 1 To 8)
Dim r As Long
Dim c As Long
Dim shNew As Worksheet

For r = 1 To 15
For c = 1 To 8
BidItem(r, c) = Cells(r, c).Value
Next c
Next r

For r = 1 To 15

Set shNew = Worksheets.Add after:=sheets(sheets,count) ' Errors here because of syntax error
shNew.Name = BidItem(r, 3)
shNew.Range("a2").Value = BidItem(r, 3)
shNew.Range("b2").Value = BidItem(r, 4)
shNew.Range("c2").Value = BidItem(r, 5)
shNew.Range("d2").Value = BidItem(r, 6)
Next r

End Sub

 

[bhalbach]

Do you mind giving me another lesson?

Since I have to go about populating a Template different than I wanted...

Where in this code would I put the "Select Case" code so that a sheet will not be created if column "A" includes the words "Header", "Total" or "Subtotal" or part thereof. it can't be case sensitive in case it is written in upper or lower case or combination. Or alternatively the other option is to add sheets if column "A" only includes "Bid Item" in the contents of the cell.

Same scenario you gave me advice on yesterday.

It is a code I had adapted from someone...works very well. Just need this little tweak.

Sub BuildWorksheets()
    'FillOutTemplate()
    'Jerry Beaucaire  4/25/2010
    'From sheet DATA, data fill out template on EstSheet & TskSheet and save
    'each sheet as its own file.
    Dim LastRw As Long, Rw As Long, Cnt As Long
    Dim dSht As Worksheet, tSht As Worksheet
    Dim MakeBooks As Boolean, SavePath As String
    Application.ScreenUpdating = False  'speed up macro execution
    Application.DisplayAlerts = False   'no alerts, default answers used
    Sheets("TskSheet").Visible = True
    Sheets("EstSheet").Visible = True
    Set dSht = Sheets("Data")           'sheet with data on it starting in row 2
    Set tSht = Sheets("TskSheet")       'template sheet to copy and fill out to row 2
    Set eSht = Sheets("EstSheet")       'template sheet to copy and fill out to row 2
    'Option to create separate workbooks
        MakeBooks = MsgBox("Create separate workbooks?" & vbLf & vbLf & _
            "YES = template will be copied to separate workbooks." & vbLf & _
            "NO = template will be copied to sheets within this same workbook", _
                vbYesNo + vbQuestion) = vbYes
    If MakeBooks Then   'select a folder for the new workbooks
        MsgBox "Please select a destination for the new workbooks"
        Do
            With Application.FileDialog(msoFileDialogFolderPicker)
                .AllowMultiSelect = False
                .Show
                If .SelectedItems.Count > 0 Then    'a folder was chosen
                    SavePath = .SelectedItems(1) & "\"
                    Exit Do
                Else                                'a folder was not chosen
                    If MsgBox("Do you wish to abort?", _
                        vbYesNo + vbQuestion) = vbYes Then Exit Sub
                End If
            End With
        Loop
    End If
    'Determine last row of data then loop through the rows one at a time
    LastRw = dSht.Range("c" & Rows.Count).End(xlUp).Row '*******was D, changed to C
    Dim shN As String
    For Rw = 2 To LastRw 'Data that will fill templates starts on this row.
           'copy the template
        With ActiveSheet      'fill out the form
            'edit these rows to fill out your form, add more as needed
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(CStr(dSht.Range("c" & Rw).Value)) '********was D, changed to C
            On Error GoTo 0
            If ws Is Nothing Then
                eSht.Copy After:=Worksheets(Worksheets.Count)
                ActiveSheet.Name = CStr(dSht.Range("c" & Rw).Value) '********was D, changed to C
                ActiveSheet.Range("a2").Value = dSht.Range("a" & Rw).Value
                ActiveSheet.Range("b2").Value = dSht.Range("b" & Rw).Value
                ActiveSheet.Range("c2").Value = dSht.Range("C" & Rw).Value
                ActiveSheet.Range("d2").Value = dSht.Range("d" & Rw).Value
                ActiveSheet.Range("e2").Value = dSht.Range("e" & Rw).Value
                ActiveSheet.Range("f2").Value = dSht.Range("f" & Rw).Value
                ActiveSheet.Range("g2").Value = dSht.Range("g" & Rw).Value
            
                shN = ActiveSheet.Range("c2").Value
                'ActiveSheet.Protect Password:="biff1972"
                tSht.Copy After:=Worksheets(Worksheets.Count)
                ActiveSheet.Name = shN & "(1)"
                ActiveSheet.Range("a2").Value = dSht.Range("a" & Rw).Value
                ActiveSheet.Range("b2").Value = dSht.Range("b" & Rw).Value
                ActiveSheet.Range("c2").Value = dSht.Range("C" & Rw).Value
                ActiveSheet.Range("d2").Value = dSht.Range("d" & Rw).Value
                ActiveSheet.Range("e2").Value = dSht.Range("e" & Rw).Value
                ActiveSheet.Range("f2").Value = dSht.Range("f" & Rw).Value
                ActiveSheet.Range("g2").Value = dSht.Range("g" & Rw).Value
           
                'ActiveSheet.Protect Password:="biff1972"
            End If
        End With
        If MakeBooks Then       'if making separate workbooks from filled out form
            ActiveSheet.Move
            ActiveWorkbook.SaveAs SavePath & Range("d3").Value, xlNormal
            ActiveWorkbook.Close False
        End If
        Cnt = Cnt + 1
    Next Rw
        dSht.Activate
        If MakeBooks Then
            MsgBox "Workbooks created: " & Cnt
        Else
            MsgBox "Worksheets created: " & Cnt
        End If
    Sheets("TskSheet").Visible = False
    Sheets("EstSheet").Visible = False
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

As this is a different question it needs it's own thread. Thanks

 

[bhalbach]

I made a new question. It’s named:

VBA Add New Sheets based on a list, Excluding specific ones with a condition on the list

 

[Fluff]

Thank you.