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

bhalbach

Board Regular
Joined
Mar 15, 2018
Messages
221
Office Version
  1. 2016
Platform
  1. Windows
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

Board Regular
Joined
Mar 15, 2018
Messages
221
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code:
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
 
Last edited by a moderator:

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,448
Office Version
  1. 365
Platform
  1. Windows
As this is a different question it needs it's own thread. Thanks
 

bhalbach

Board Regular
Joined
Mar 15, 2018
Messages
221
Office Version
  1. 2016
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,448
Office Version
  1. 365
Platform
  1. Windows
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,678
Messages
5,838,737
Members
430,566
Latest member
ChanchalSingh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top