Excel: Auto Duplicate workbook and based off list

Question

Pretty new to VBA (total noob) and struggling hard, I've been cannibalizing bits of formula off various parts of the forum to get what I need and now I'm stuck.

Basically I have a workbook I need said workbook duplicating many times and for it to create the save name from a list here's what I have so far

Sub create()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("List") 'Edit sheet name
Set sh2 = Sheets("Data") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A1:A" & lr)

For Each c In rng
    Sheets("Template").Copy 'Edit sheet name
    Set wb = ActiveWorkbook
    wb.Sheets(1).Range("A1") = c.Value
    sh2.Copy After:=wb.Sheets(1)
    wb.SaveAs c.Value & ".xlsx"
    wb.Close False
Next
End Sub

So List Is obviously my list of names for the files and it works well, however the workbook has more sheets other than "Data" and "Template" so if I had other sheets named "Data2" and "Data3" for instance how could I write them in to also be copied into the workbooks that are created.

Thank you in advance you wonderful people.

Alex

So to summarise you want your code to save your sheets as a separate individual workbook for each sheet? — Calum
– Calum, Commented Oct 16, 2015 at 10:32
@Calum No not quite at the moment if I add other sheets into the original workbook it won't add them into the workbooks the macro at the moment it only adds in my "template" and "data" tabs if I was to add further tabs i.e. "data2" writing: Set sh3 = Sheets("Data2") 'Edit sheet name That doesn't work, if that makes sense. Sorry if it seems vague. — Rojas
– Rojas, Commented Oct 16, 2015 at 11:19
if that's all you want then keep with Set sh3 = Sheets("Data2") then after sh2.Copy After:=wb.Sheets(1) underneath add sh3.Copy After:=wb.Sheets(1) and do the same for each sheet. — Calum
– Calum, Commented Oct 16, 2015 at 11:50
Yeah, loops would definently be the most efficient way, but considering he said he was totally new I just give the basics. — Calum
– Calum, Commented Oct 16, 2015 at 12:05

R3uK · Accepted Answer · 2015-10-23 05:55:01Z

0

I guess this one will be more efficient and easily editable than your initial version :

Sub create()
Dim WbSrc As Workbook, _
    WbDest As Workbook, _
    SheetToExport As String, _
    sh1 As Worksheet, _
    lr As Long, _
    rng As Range, _
    A() As String


Set WbSrc = ThisWorkbook
Set sh1 = WbSrc.Sheets("List") '----Edit sheet name
lr = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).Row
Set rng = sh1.Range("A1:A" & lr)

'----Add sheet's names here separated with /
'----They will be exported in the same order
SheetToExport = "Template/Data/Data2"
A = Split(SheetToExport, "/")

'----Make a new workbook with all the sheet you want to export
WbSrc.Sheets(A(0)).Copy
Set WbDest = ActiveWorkbook
For i = LBound(A) + 1 To UBound(A)
    WbSrc.Sheets(A(i)).Copy After:=WbDest.Sheets(WbDest.Sheets.Count)
Next i

'----Now that the base is good, change value in A1 and SaveAs
For Each c In rng
    WbDest.Sheets(1).Range("A1") = c.Value
    Set WbDest = WbDest.SaveAs(c.Value & ".xlsx")
Next c

WbDest.Close False

End Sub

edited Oct 23, 2015 at 5:55

answered Oct 16, 2015 at 12:03

R3uK

14.6k8 gold badges49 silver badges81 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

R3uK Over a year ago

Glad I could help! As you are new to SO, just a quick reminder of the basics : Once an answer solved your issue, please validate it with the tick right under up/down votes. And remember to use the up/down votes (once you have 15 reputation points) if you find any post useful/useless! ;) Enjoy SO!

Darren Bartrup-Cook · Accepted Answer · 2015-10-16 12:18:15Z

A few minutes late.
I'd write it like the code below.
Rather than state which sheets to copy in the code just add the sheet names in column A and TRUE in column B if you want it copied, then in another column add the file names you want to use.

Can use a formula to calculate how long your named range is - something like =Sheet1!$A$1:INDEX(Sheet1!$A:$A,COUNTA(Sheet1!$A:$A)) to take all values in column A of sheet1.

Public Sub Create()

    Dim wrkBk As Workbook
    Dim wrkSht As Worksheet
    Dim rngFiles As Range
    Dim rngSheets As Range
    Dim c As Range
    Dim d As Range

    'Named ranges in your workbook.
    Set rngFiles = Range("FileNames")
    Set rngSheets = Range("SheetsToCopy")

    'Each file name
    For Each d In rngFiles
        Set wrkBk = Nothing

        'Check if each sheet is needed - 1 column to right of
        'sheet name states TRUE if you want the sheet copied.
        For Each c In rngSheets
            If c.Offset(, 1) = True Then

                If wrkBk Is Nothing Then
                    'Create a new workbook if one hasn't been created.
                    ThisWorkbook.Worksheets(c.Value).Copy
                    Set wrkBk = ActiveWorkbook
                Else
                    'If workbook has been created then copy sheets to it.
                    ThisWorkbook.Worksheets(c.Value).Copy _
                        After:=wrkBk.Sheets(1)
                End If
            End If
        Next c
        'Save the file and close it.
        wrkBk.SaveAs d.Value & ".xlsx", FileFormat:=xlWorkbookDefault
        wrkBk.Close
    Next d

End Sub

Collectives™ on Stack Overflow

Excel: Auto Duplicate workbook and based off list

2 Answers 2

1 Comment

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Related