VBA: Use loops to copy a groups of worksheets into multiple workbooks

[gmnaught]

Hello,
I created a macro that uses a counter to create 3 worksheets for each country included in a data tab. The data tab can have a variable number of countries, so the macro counts the number of countries and creates a Cover Sheet, Expense Sheet, and Income Sheet for each country (e.g. the resulting worksheet names would be Cover Sheet 1, Expenses 1, Income 1, Cover Sheet 2, Expenses 2, Income 2, etc). Below is a condensed summary of the pertinent macro.

Sub CreateCountryWorksheets
Dim ws As Worksheet, wsTemplate As Worksheet
Dim n As Integer, i As Long

n = ws.Range("D1").Value
If n > 0 Then
For i = 1 To n
wsCover.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Cover Sheet " & i
‘Bunch of stuff

wsExpense.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Expenses " & i
‘Bunch of stuff

wsIncome.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Income " & i
‘Bunch of stuff
Next i
End If

‘Other stuff

End Sub

The macro is working fine, but now I received a request to keep the workbook intact with all the countries and all three tabs, but also create a new workbook for each country with just the three tabs pertinent to each country. Each new workbook would need to be saved in the same path.

I think I need to use loops, but I can’t figure out whether to 1) include a Save As in the loops that I already have or 2) or create all the worksheets first then find all 3 sheet names which contain the same number (1 to i) to then Save As. Either way, I am not sure of the code to use. I can manage with loops to find one sheet name, but finding 3 sheets and Saving As is throwing me.

I am fairly familiar with VBA, but specific code would be very helpful.

Thank you so much.

 

[JLGWhiz]

Using the same code but adding lines

Sub CreateCountryWorksheets()
Dim ws As Worksheet, wsTemplate As Worksheet
Dim n As Integer, i As Long
n = ws.Range("D1").Value
    If n > 0 Then
        For i = 1 To n
            wsCover.Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = "Cover Sheet " & i
            'Bunch of stuff
            wsExpense.Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = "Expenses " & i
            'Bunch of stuff
            wsIncome.Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = "Income " & i
            'Bunch of stuff
          [COLOR=#ff0000]  wsCover.Copy 'Creates new workbook
            ActiveSheet.Name = "Cover" & i
            wsExpense.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
            ActiveSheet.Name = "Expense" & i
            wsIncome.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
            ActiveSheet.Name = "Income" & i
            'Any clean up code
            ActiveWorkbook.SaveAs (Country & i) 'Modify to requirements
            ActiveWorkbook.Close False[/COLOR]
        Next i
    End If
‘Other stuff
End Sub

 

[gmnaught]

I apologize for the delay in my response. I had to work on other projects and couldn’t test the new code. That being said, THANK YOU SO MUCH. It is very close to what I need.

The code you provided copies the original Cover, Expense, and Income sheets. I should have explained that I need to copy these sheets after the code to do a “Bunch of stuff”. This code modifies the sheets to be specific to each country. So I really need to copy the resulting “Cover“ & i, “Expense”&i, and “Income”&i worksheets that have been modified by the “Bunch of stuff” code and save the resulting worksheets in the new workbooks.

Do I possibly need to add a DIM statement (not sure if that’s the technical name) for each newly named worksheet in the loop and then copy? If so, I’m not sure how to do that. I really don't know and am taking a stab in the dark.

Any help you can give is greatly appreciated!

Thank you again!

 

[gmnaught]

Using my old code and a modification of the new code, I figured out what I needed to do to get the modified sheets into new workbooks. Please see below if anyone is interested:

Sub CreateCountryWorksheets
s = ActiveWorkbook.FullName
Dim ws As Worksheet, wsTemplate As Worksheet
Dim n As Integer, i As Long
Set wsCover = Sheets("Cover")
Set wsExpense = Sheets("Expenses")
Set wsIncome = Sheets("Income")

n = ws.Range("D1").Value
If n > 0 Then
For i = 1 To n
wsCover.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Cover Sheet " & i
‘Bunch of stuff to modify the Cover sheet
Set wsCoveri = Sheets("Cover " & i)


wsExpense.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Expenses " & i
‘Bunch of stuff to modify the Expense sheet
Set wsExpensei = Sheets("Expenses " & i)

wsIncome.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Income " & i
‘Bunch of stuff to modify the Income sheet
Set wsIncomei = Sheets("Income " & i)
‘Add the new code with adjustments to create new files
wsCoveri.Copy 'Creates new workbook
ActiveSheet.Name = "Cover " & i
wsExpensesi.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = "Expenses " & i
wsIncomei.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = "Income " & i

'Any clean up code

ActiveWorkbook.SaveAs Filename:=Left(s, Len(s) - 5) & " Country" & i & " " & Format(Date, "yyyy_mm_dd") & ".xlsx", FileFormat:=51
ActiveWorkbook.Close False

Next i

End If

‘Other stuff

End Sub